Macro to find matching numbers in column A and replace all row cells of the original number with row cell of the matching number

E

ener

New Member
Joined
Feb 2, 2013
Messages
22
Sample:

[TABLE="width: 430"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]aaaaa[/TD]
[TD]bbbbb[/TD]
[TD]ccccc[/TD]
[TD]ddddd[/TD]
[/TR]
[TR]
[TD]105[/TD]
[TD]eeeee[/TD]
[TD]fffff[/TD]
[TD]ggggg[/TD]
[TD]hhhhh[/TD]
[/TR]
[TR]
[TD]103[/TD]
[TD]jjjjj[/TD]
[TD]kkkkk[/TD]
[TD]lllll[/TD]
[TD]zzzzz[/TD]
[/TR]
[TR]
[TD]157[/TD]
[TD]xxxxx[/TD]
[TD]ccccc[/TD]
[TD]vvvvv[/TD]
[TD]bbbbb[/TD]
[/TR]
[TR]
[TD]133[/TD]
[TD]nnnnn[/TD]
[TD]mmmmm[/TD]
[TD]qqqqq[/TD]
[TD]wwwww[/TD]
[/TR]
[TR]
[TD]105[/TD]
[TD]eeeee[/TD]
[TD]fffff[/TD]
[TD]ggggg[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]aaaab[/TD]
[TD]bbbbb[/TD]
[TD]ccccc[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]157[/TD]
[TD]xxxxx[/TD]
[TD]ccccc[/TD]
[TD]vvvvv[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]133[/TD]
[TD]nnnnn[/TD]
[TD]mmmmm[/TD]
[TD]qqqqq[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]122[/TD]
[TD]aaabb[/TD]
[TD]bbbcc[/TD]
[TD]cccdd[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

What it should look like at the end:


[TABLE="width: 686"]
<tbody>[TR]
[TD][TABLE="width: 430"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]aaaab[/TD]
[TD]bbbbb[/TD]
[TD]ccccc[/TD]
[TD]ddddd[/TD]
[/TR]
[TR]
[TD]105[/TD]
[TD]eeeee[/TD]
[TD]fffff[/TD]
[TD]ggggg[/TD]
[TD]hhhhh[/TD]
[/TR]
[TR]
[TD]103[/TD]
[TD]jjjjj[/TD]
[TD]kkkkk[/TD]
[TD]lllll[/TD]
[TD]zzzzz[/TD]
[/TR]
[TR]
[TD]157[/TD]
[TD]xxxxx[/TD]
[TD]ccccc[/TD]
[TD]vvvvv[/TD]
[TD]bbbbb[/TD]
[/TR]
[TR]
[TD]133[/TD]
[TD]nnnnn[/TD]
[TD]mmmmm[/TD]
[TD]qqqqq[/TD]
[TD]wwwww[/TD]
[/TR]
[TR]
[TD]122[/TD]
[TD]aaabb[/TD]
[TD]bbbcc[/TD]
[TD]cccdd[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
Hi Guys,
I really hope someone can help. I am just starting to learn VB but as I have very little time to study it would probably take a few months before I could write the code. This could be very difficult or very simple. Not quite sure.

What I need:
1st compare all numbers in Column A beginning with A2 and if number appears again further down copy all the information from that row into relevant Columns where the first number was

It's easier with an example: Cell A2 has the number 101 in it. Now we need to check A3, A4 A5 etc to see if the number 101 appears again. It does so in Cell A8. Now I would need the Info contained in B8 copied to B2, C8 to C2, D8 to D2. The information in the E column (Comments) should not be overwritten so no copying E8 to E2 is necessary. After that is done complete ROW 8 should be deleted.

Then A3 which contains number 105 should be checked for a another A column that also contains 105. It does so in A7 and we again copy all the info from that this row to Row 3. Once again ignoring the Comment Column . After all the info is copied Row 7 can be deleted.

That needs to be continued for all the other numbers in Column A until there are no numbers left.
There are some circumstances where a number in Column A is there only once. Eg. Cell A4 contains number 103 and there is no other number 103 anywhere in Column A. If that happens the row should be marked all red (or highlighted in some other way) so I can check that particular number manually.
That case also happens for cell A11 that has number 122 which also appears only once. Again that whole column would need to be marked somehow (either color or any other feature) so I can look at that one manually.

You can see what it should look like at the end in my sample.

Here is some additional info:

This is all very simplified. There are many more rows and columns than this but usually I can adjust the code depending on the amount of columns /rows. There are usually no more than 200 rows though.
The columns contain different data sets such as numbers, dates and formulas. Not sure if that makes any difference when copying data from one row to another.
Sometimes there are no changes at all or everything changed.
The most amount of matching numbers are 2. Never more but sometimes there is only a single number as explained above.
 
Sort by date Sort by votes
Hi ener,

I think the following matches your requirement.

Code: 
Sub Update_data()
Dim rTest As Range, rSearch As Range, rResult As Range

With ActiveSheet
    Set rTest = .Range("A2")
    Do
    Set rSearch = Range(rTest, .Range("A" & .Rows.Count).End(xlUp))
    Set rResult = rSearch.Find(What:=rTest, After:=rTest, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
    If rResult.Address <> rTest.Address Then
        rResult.Offset(0, 1).Resize(1, 3).Copy rTest.Offset(0, 1).Resize(1, 3)
        rResult.EntireRow.Delete
    End If
    Set rTest = rTest.Offset(1, 0)
    Loop While rTest.Row < .Range("A" & .Rows.Count).End(xlUp).Row
End With
End Sub
 
Upvote 0
Teeroy said:
Hi ener,

I think the following matches your requirement.

Code: 
Sub Update_data()
Dim rTest As Range, rSearch As Range, rResult As Range

With ActiveSheet
    Set rTest = .Range("A2")
    Do
    Set rSearch = Range(rTest, .Range("A" & .Rows.Count).End(xlUp))
    Set rResult = rSearch.Find(What:=rTest, After:=rTest, LookIn:=xlValues, LookAt:= _
        xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=False)
    If rResult.Address <> rTest.Address Then
        rResult.Offset(0, 1).Resize(1, 3).Copy rTest.Offset(0, 1).Resize(1, 3)
        rResult.EntireRow.Delete
    End If
    Set rTest = rTest.Offset(1, 0)
    Loop While rTest.Row < .Range("A" & .Rows.Count).End(xlUp).Row
End With
End Sub
Click to expand...


Thank you so much Teeroy for the Code. I will check it tomorrow and Monday I can run it with the actual file I have at work which contains a lot more entries (columns/rows) and I will let you know.

I really appreciate your effort.

Thanks again.
 
Upvote 0
Hi Teeroy or anyone else. I did run the code but the end result is not quite correct. Here is the result I received:

[TABLE="width: 430"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[TD]Column E[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]aaaaa[/TD]
[TD]bbbbb[/TD]
[TD]ccccc[/TD]
[TD]ddddd[/TD]
[/TR]
[TR]
[TD]105[/TD]
[TD]eeeee[/TD]
[TD]fffff[/TD]
[TD]ggggg[/TD]
[TD]hhhhh[/TD]
[/TR]
[TR]
[TD]103[/TD]
[TD]jjjjj[/TD]
[TD]kkkkk[/TD]
[TD]lllll[/TD]
[TD]zzzzz[/TD]
[/TR]
[TR]
[TD]157[/TD]
[TD]xxxxx[/TD]
[TD]ccccc[/TD]
[TD]vvvvv[/TD]
[TD]bbbbb[/TD]
[/TR]
[TR]
[TD]133[/TD]
[TD]nnnnn[/TD]
[TD]mmmmm[/TD]
[TD]qqqqq[/TD]
[TD]wwwww[/TD]
[/TR]
[TR]
[TD]122[/TD]
[TD]aaabb[/TD]
[TD]bbbcc[/TD]
[TD]cccdd[/TD]
[TD]dddee

[/TD]
[/TR]
</tbody>[/TABLE]

Please see again what it should look like below:

[TABLE="class: cms_table, width: 430"]
<tbody>[TR]
[/TR]
[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[TD]Comments[/TD]
[/TR]
[TR]
[TD]101[/TD]
[TD]aaaab[/TD]
[TD]bbbbb[/TD]
[TD]ccccc[/TD]
[TD]ddddd[/TD]
[/TR]
[TR]
[TD]105[/TD]
[TD]eeeee[/TD]
[TD]fffff[/TD]
[TD]ggggg[/TD]
[TD]hhhhh[/TD]
[/TR]
[TR]
[TD]103[/TD]
[TD]jjjjj[/TD]
[TD]kkkkk[/TD]
[TD]lllll[/TD]
[TD]zzzzz[/TD]
[/TR]
[TR]
[TD]157[/TD]
[TD]xxxxx[/TD]
[TD]ccccc[/TD]
[TD]vvvvv[/TD]
[TD]bbbbb[/TD]
[/TR]
[TR]
[TD]133[/TD]
[TD]nnnnn[/TD]
[TD]mmmmm[/TD]
[TD]qqqqq[/TD]
[TD]wwwww[/TD]
[/TR]
[TR]
[TD]122[/TD]
[TD]aaabb[/TD]
[TD]bbbcc[/TD]
[TD]cccdd

[/TD]
[/TR]
</tbody>[/TABLE]

Cell B2 should say aaaab as cell C8 has that info in there. So the newer information are always in the 2nd matching number it finds. So Row 8 (101) has newer info than Row 2 (101), Row 7 has newer info than Row 3 (105) etc. etc.

Also, Row 7 in the results (122) should not have any comments in there at all as there were no comments in there at all in the first place and no other matching number 122 in the spreadsheet.

Lastly and I am not 100% sure if that is possible could row A3 (103) and A7 (122) be marked/highlighted somehow such as red font color as those numbers are listed only once in the original data (no 2nd matching number)

know you already spend time on this and it would be great if you could have a 2nd look but as I said if it's too much work I will figure it out eventually.

Thanks again.

P.S. Hope the code works the same in all Excel versions. I am running Excel 2007
 
Upvote 0
I have run the code on both excel2003 and excel2010 and get the correct results (same as you've posted). I don't understand how you got the first results as the last comment (E7) is not even included in the test data that you supplied. The one thing I can think of that may cause an issue is if you have a space after the number in a cell in column A, since that's not a whole match. Anyway I've added the font change below, please try it and let me know how you go.

Code: 
Sub Update_data()
Dim rTest As Range, rSearch As Range, rResult As Range
With ActiveSheet
    Set rTest = .Range("A2")
    Do
        Set rSearch = Range(rTest, .Range("A" & .Rows.Count).End(xlUp))
        Set rResult = rSearch.Find(What:=rTest, After:=rTest, LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)
        If rResult.Address <> rTest.Address Then
            rResult.Offset(0, 1).Resize(1, 3).Copy rTest.Offset(0, 1).Resize(1, 3)
            rResult.EntireRow.Delete
        Else
            rTest.Resize(1, 5).Font.Color = vbRed
        End If
        Set rTest = rTest.Offset(1, 0)
    Loop While rTest.Row < .Range("A" & .Rows.Count).End(xlUp).Row
End With
End Sub
 
Upvote 0
Awesome, its working now.

Only thing is Row 7 with the number 122 is not highlited in red like row 3 (103). Maybe that could be added. Otherwise this is great. I will run it for the actual Excel sheet a bit later which has more rows and columns but the principle is always the same. Thanks again so much.

Below is the one line that didn't get marked red (122 appears only once in column A) so hopefully only a minor change is needed.
[TABLE="width: 587"]
<TBODY>[TR]
[TD]122</SPAN>
[/TD]
[TD]aaabb</SPAN>
[/TD]
[TD]bbbcc</SPAN>
[/TD]
[TD]cccdd
[/TD]
[TD]

[/TD]
[/TR]
</TBODY>[/TABLE]
 
Upvote 0
Hi Ener,
My fault, I forgot that the last row (which isn't searched) could be a loner. I've added a final test that fixes it.

Code: 
Sub Update_data()
Dim rTest As Range, rSearch As Range, rResult As Range
With ActiveSheet
    Set rTest = .Range("A2")
    Do
        Set rSearch = Range(rTest, .Range("A" & .Rows.Count).End(xlUp))
        Set rResult = rSearch.Find(What:=rTest, After:=rTest, LookIn:=xlValues, LookAt:= _
            xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
            , SearchFormat:=False)
        If rResult.Address <> rTest.Address Then
            rResult.Offset(0, 1).Resize(1, 3).Copy rTest.Offset(0, 1).Resize(1, 3)
            rResult.EntireRow.Delete
        Else
            rTest.Resize(1, 5).Font.Color = vbRed
        End If
        Set rTest = rTest.Offset(1, 0)
        If rTest.Row = .Range("A" & .Rows.Count).End(xlUp).Row Then
            rTest.Resize(1, 5).Font.Color = vbRed
        End If
    Loop While rTest.Row < .Range("A" & .Rows.Count).End(xlUp).Row
End With
End Sub
 
Upvote 0
Hi Teeroy,

Working perfectly now. I will be able to test it on some of my actual documents over the next few days but as I said only difference is that there are a few more columns and rows so hopefully I will be able to adjust the code myself.


Thanks so much for all your help. I owe you a beer :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Find the missing numbers from the range of numbers and filling the missing number in the cells below the last row
Replies
6
Views
627
sekar
S
M
  • Solved
Combining Data Based on Previous Column Data
Replies
3
Views
543
Fluff
Fluff
R
  • Question Question
Finding a number in a range from 1 cell
2
Replies
10
Views
1K
Peter_SSs
Peter_SSs
F
  • Question Question
Pull Data From Two Tables
Replies
2
Views
978
FiddleRox
F
F
  • Question Question
Pull Data From Two Tables Using 2 Drop Lists
Replies
2
Views
828
FiddleRox
F

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top