Need Small change in this macro

[gameover]

Hi All,
I need some changes in below code. This code compare column A in 2 sheets and copy values which are present in Column B and C of 2^nd sheet. What I need is that macro compares columns A, B and C in both sheet and if all values are same then it copies value in column D and paste in sheet 1. Any ideas…….Thanks a lot for your time and answers.

' ws1 and ws2 are worksheet objects. Set them to point to the sheets.
'ws2 is updated sheet
'ws1 is the sheet where values are updated by the code.

For Each cell In ws2.Range("A1:A" & ws2.Range("A1048576").End(xlUp))
    If cell = "" Then GoTo nextVal
    Set rng1 = ws1.Range("A1").EntireColumn.Find(cell)
    If rng1 Is Nothing Then GoTo nextVal
    ws1.Cells(rng1.Row, rng1.Column + 1) = ws2.Cells(cell.Row, cell.Column + 1)
    ws1.Cells(rng1.Row, rng1.Column + 2) = ws2.Cells(cell.Row, cell.Column + 2)
   
nextVal:
Next

 

[Arithos]

Hi All,
I need some changes in below code. This code compare column A in 2 sheets and copy values which are present in Column B and C of 2^nd sheet. What I need is that macro compares columns A, B and C in both sheet and if all values are same then it copies value in column D and paste in sheet 1. Any ideas…….Thanks a lot for your time and answers.

' ws1 and ws2 are worksheet objects. Set them to point to the sheets.
'ws2 is updated sheet
'ws1 is the sheet where values are updated by the code.

For Each cell In ws2.Range("A1:A" & ws2.Range("A1048576").End(xlUp))
    If cell = "" Then GoTo nextVal
    Set rng1 = ws1.Range("A1").EntireColumn.Find(cell)
    If rng1 Is Nothing Then GoTo nextVal
    ws1.Cells(rng1.Row, rng1.Column + 1) = ws2.Cells(cell.Row, cell.Column + 1)
    ws1.Cells(rng1.Row, rng1.Column + 2) = ws2.Cells(cell.Row, cell.Column + 2)
   
nextVal:
Next

Hi,

You say you need "some changes", are there problems with your code?
If so, in what lines.
Will the values in column A, B , C for both sheets be on the same row? (it seems its not since you use the .Find() func)

 

[Arithos]

This works on my end:

Sub testering()' ws1 and ws2 are worksheet objects. Set them to point to the sheets.
'ws2 is updated sheet
'ws1 is the sheet where values are updated by the code.
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
ws2.Select
For Each cell In ws2.Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
    If cell = "" Then GoTo nextVal
    Set rng1 = ws1.Range("A1").EntireColumn.Find(cell)
    If rng1 Is Nothing Then GoTo nextVal
    ws1.Cells(rng1.Row, rng1.Column + 1).Value = ws2.Cells(cell.Row, cell.Column + 1).Value
    ws1.Cells(rng1.Row, rng1.Column + 2).Value = ws2.Cells(cell.Row, cell.Column + 2).Value
nextVal:
Next


ws1.Select
End Sub

However, this searches the entire column every time. So, if you have the same observation two times, this will end up doing the wrong stuff.
If this is the case, let me know

 

[Arithos]

You can also rewrite the set rng line like this.

Set rng1 = ws1.Range("A:A").Find(cell)

I noticed one more mistake with the code aswell, it does not seem to find the first value in sheet 1, cell A1, and hence does not paste anything there. I will look into this


**Looked into it** For some reason its having troubles matching the value "3"... Does anyone else know why that is?

 

[gameover]

Dear Strula, I have same observation more than 1 time many times. My initial table has Column A in sheet 1 Customer No. and Column A in sheet 2 customer no., column B in sheet 2 some value and also some value in column C. The macro which I presented here checked all the cells in column A and matches it with values in sheet 2 Column A and if it matches copy the values from B and C column from sheet 2 of matched customer id and paste it in sheet 1. Now I need a change in macro which compares column A, B and C of sheet 1 with column A, B and C of sheet 2 and if all 3 value matched then copy whatever the value is written in column D and paste in column D of sheet 1. e.g. Sheet 1: Column A: 001 Column B: US column C: 2007 and Sheet 2: Column A: 001 Column B: US column C: 2007 column D: New then the macro should copy new and paste it in sheet1. The customer Id in sheet 2 are unique but there are many instances of repeated value in sheet 1 for customer id. Hope I made myself clear here. Please let me know if you need more info.

 

[gameover]

1 more info. I have over 200K rows in sheet 1 and more than 12K rows in sheet 2.

 

[Arithos]

Dear Strula, I have same observation more than 1 time many times. My initial table has Column A in sheet 1 Customer No. and Column A in sheet 2 customer no., column B in sheet 2 some value and also some value in column C. The macro which I presented here checked all the cells in column A and matches it with values in sheet 2 Column A and if it matches copy the values from B and C column from sheet 2 of matched customer id and paste it in sheet 1. Now I need a change in macro which compares column A, B and C of sheet 1 with column A, B and C of sheet 2 and if all 3 value matched then copy whatever the value is written in column D and paste in column D of sheet 1. e.g. Sheet 1: Column A: 001 Column B: US column C: 2007 and Sheet 2: Column A: 001 Column B: US column C: 2007 column D: New then the macro should copy new and paste it in sheet1. The customer Id in sheet 2 are unique but there are many instances of repeated value in sheet 1 for customer id. Hope I made myself clear here. Please let me know if you need more info.

Aha, you want two more criterias, now three cells, Ax, Bx, and Cx, then paste cell Dx, into sheet 1, beside the match. Correct?

 

[Arithos]

Then, this one will do what you wish

Sub testering()
Set ws1 = Sheets(1)
Set ws2 = Sheets(2)
ws2.Select
Dim cell As Range


Set tr = ws2.Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))


For Each cell In tr
    If cell = "" Then GoTo nextVal
    Set rng1 = ws1.Range("A:A").Find(cell)
    If rng1 Is Nothing Then GoTo nextVal
    
    c1 = cell.Row
    r1 = rng1.Row
    If ws2.Cells(c1, 1).Value = ws1.Cells(r1, 1).Value Then
        If ws2.Cells(c1, 1).Offset(0, 1).Value = ws1.Cells(r1, 1).Offset(0, 1).Value Then
            If ws2.Cells(c1, 1).Offset(0, 2).Value = ws1.Cells(r1, 2).Offset(0, 1).Value Then
                    ws1.Cells(r1, 4).Value = ws2.Cells(c1, 4).Value
            End If
        End If
    End If
nextVal:
Next
ws1.Select
End Sub

Try it out, and let me know

 

[gameover]

Dear Sturla, You got my problem perfectly and thanks for the macro. But there is a problem with it. 1st of all it doesn't fill all the values. e.g I have in column D of sheet 2 New and Old. What macro does is pick only "new" value and paste it in sheet 1. Secondly as stated earlier also there are more than 1 instance of same value in column A. The macro fills only 1st instance and leave all other blank. You are in right track but anymore insights?????? Thanks again for all your help and time. PS: I have 200K rows in sheet 1 and 13K rows in sheet 2.

 

[Arithos]

Dear Sturla, You got my problem perfectly and thanks for the macro. But there is a problem with it. 1st of all it doesn't fill all the values. e.g I have in column D of sheet 2 New and Old. What macro does is pick only "new" value and paste it in sheet 1. Secondly as stated earlier also there are more than 1 instance of same value in column A. The macro fills only 1st instance and leave all other blank. You are in right track but anymore insights?????? Thanks again for all your help and time. PS: I have 200K rows in sheet 1 and 13K rows in sheet 2.

I have a workaround for the multiple values of the same value in col A. I'm not completely sure what you mean by, new and old. New terminology. Are those the ws1-2 and the information in theese sheets?