0

I have 2 excel sheets, where I would like to find and replace values, however I would like to have multiple replace values take the spot of one match value. 

Sheet 1:                              Sheet 2:

Match Value                           Match Value   New Value
28045000                              28045000      28051560
39162010                              28045000      28056549
39269000                              39162010      39596000

All Match Values in sheet 1 are unique, while match values in sheet 2 may have duplicates because they correspond to multiple new values. So, if the match value in sheet 1 and sheet 2 are the same, then I want to replace the match value in sheet 1 with all of the new values that correspond to the match value. Sheet 1 after the replacements have been made should look like this: 

Sheet 1:                        

Match Value                           
28051560 
28056549                           
39596000                              
39269000

So as we can see, 28045000 was replaced by 2 values, 28051560 and 28056549 in 2 separate cells, while 39162010 was replaced by 39596000, while 39269000 which did not have a match value in sheet 2, remained the same.

I would typically do this manually, but there are about 30,000 rows of data, some with over to 10 values matching a single match value. I have the following code, however, this does not properly replace the match value with all of the new values. Is there a way to get Excel to search through the entire range of both sheets and make the proper changes automatically?

Sub multiFindNReplace()
    Dim myList, myRange
    Set myList = Sheets("sheet 1").Range("A1:A5000") 
    Set myRange = Sheets("sheet2").Range("A1:A5000")
    For Each cel In myList.Columns(1).Cells
        myRange.Replace what:=cel.Value, replacement:=cel.Offset(0, 1).Value
    Next cel
End Sub
Community
  • 1
  • 1
mike
  • 5
  • 1
  • 7

2 Answers2

0

I would do it like this:

The macro just loop through the first sheet and compare it with the second sheet. If it matches, it replace the value in the first, add c+1 and go on with searching. Because the orginal value is replaced then, the orignal value is stored in d, if it find a second match it dones't replace it because of c+1, it goes to the else clause, insert a row and put the value in the new row. Like this it loops through the whole column on sheet1.

PS: I hope you can understand it, i didn't had that much time, will edit later for more readability.

Update:

So here we go again, i added the maxrow counter and overcomment it for a easy understanding.

Update 2:

Now with While-Loop because of for-loops doesn't regconize limit changes

Sub CompareLoop()

'Iterator Worksheet 1, is the counter for the ws1 column
Dim iWS1 As Integer
'Iterator Worksheet 2, is the counter for the ws1 column
Dim iWS2 As Integer
'Switch New Row, is the switch if the next value need a new row
Dim sNR As Integer
'Maximal Row Count, need to be extend when new rows are added
Dim MaxRows As Integer
'valueHolder, is the holder for the orginal value, the orginal value might be replaced on the sheet
Dim valueHolder As Long

'Worksheet1
Dim ws1 As Worksheet
'Worlsheet2
Dim ws2 As Worksheet

Set ws1 = ActiveWorkbook.Worksheets("table1")
Set ws2 = ActiveWorkbook.Worksheets("table2")

'Set iWS1 to the first row
iWS1 = 1
'Get MaxRows
MaxRows = ws1.Cells(Rows.Count, 1).End(xlUp).Row

'Loop through the Rows on WS1 setting switch to 0 and store the value     from the ws1 row in the holder
While iWS1 <= MaxRows
sNR = 0
valueHolder = ws1.Cells(iWS1, 1).Value

'Loop through the Rows on WS2, searching for a value that match with the value from ws1
For iWS2 = 1 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
    'When it matches, then look if there was already a match with the value, if not replace it on the ws1 and increase the sNr to 1
    If valueHolder = ws2.Cells(iWS2, 1).Value Then
        If (sNR < 1) Then
            ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2).Value
            sNR = sNR + 1
        'When the sNR is already > 0, increase the Iterator for the ws1 that he will point on the new line
        'increase the maxrows because we got one more soon, finally insert the new row and store the value from ws2 in it
        Else
            iWS1 = iWS1 + 1
            MaxRows = MaxRows + 1
            Range(ws1.Cells(iWS1, 1), ws1.Cells(iWS1, 1)).EntireRow.Insert
            ws1.Cells(iWS1, 1).Value = ws2.Cells(iWS2, 2)
        End If
    End If
Next iWS2
iWS1 = iWS1 + 1
Wend

End Sub
thentt
  • 16
  • 4
  • This is what I am looking for. One problem I am having with your code is that I need to run the code multiple times because it is only doing one value and then it stops executing. so for example if I have 1500, that matches with 1501, 1502 and 1503, while I also have 1700 that matches with 1701 and 1702, I need to run the code twice for it to work. This becomes problematic because I have thousands in my worksheets and I have no idea how many times to execute the code. Is there a way to edit this code so that it can execute all in one run of the macro? – mike Jul 26 '16 at 16:29
  • I guess that comes from a mistake i made. It gets the row.count and later it add some rows but the for llop stop still at the same row. I will correct that – thentt Jul 27 '16 at 09:11
  • I have tried the updated copy, but I still have the same problem as above. Any reason why you think that it is happening? – mike Jul 27 '16 at 12:42
  • I found the problem, didn't know that issues exsist, will fix it. http://stackoverflow.com/questions/19409644/change-length-of-for-loop-while-in-the-loop – thentt Jul 27 '16 at 13:05
  • [@Fink](http://stackoverflow.com/users/167478/fink) explain it here: http://stackoverflow.com/a/3114247/6560622 For-Loop Variable seams to be precompiled in excel-vba – thentt Jul 27 '16 at 13:15
  • So Updated with While Loop now. – thentt Jul 27 '16 at 13:28
  • I just tested the updated code and it works! Thank you very much for your help and in depth explanations/resources! – mike Jul 27 '16 at 13:34
0

Assuming Columns start at A are contiguous and are labelled, in Sheet 1, B2 and copied down to suit: 

=IF(ISERROR(MATCH(A2,'Sheet 2'!A:A,0)),A2,"")

Copy range containing all values from Sheet 1 Column B and Paste Special, Values below last entry in Sheet 2 Column B.

Copy Sheet 2 Column B into A1 of Sheet 1 and filter to remove blanks in Column A. Delete Sheet 1 Column B.

pnuts
  • 58,317
  • 11
  • 87
  • 139