VBA to match cell contents across multiple sheets and copy data from a corresponding cell

[lyntanos]

Hi everyone,

I'm trying to sort out a VBA script that will achieve this:
I have a value in Sheet2 A1 that the user can change.
I want to create a VBA script that will search all of the cells in column K of Sheet1 (from K3 to end of filled cells in column K) for a match of the value in Sheet2 A1 and if there is a match,
copy the value of the corresponding cell in column C from Sheet1 (Starting from C3) into column B in Sheet2.

Eg. if Sheet2 A1 has matches in Sheet1 K3 and K10, copy the contents of Sheet1 C3 and C10 to Sheet2 B2 and B3.

Thanks in advance

 

[kvsrinivasamurthy]

VBA code for macro.

Sub GetValues()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Lr&
Dim M
Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")
Lr = sh2.Range("K" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If('" & sh2.Name & "'!K3:K" & Lr & "='" & sh1.Name & "'!A1,'" & sh2.Name & "'!C3:C" & Lr & ",false))"), False, False)
sh1.Range("B:B").Clear
sh1.Range("B3").Resize(UBound(M) + 1, 1) = WorksheetFunction.Transpose(M)
End Sub

 

[lyntanos]

VBA code for macro.

Sub GetValues()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Lr&
Dim M
Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")
Lr = sh2.Range("K" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If('" & sh2.Name & "'!K3:K" & Lr & "='" & sh1.Name & "'!A1,'" & sh2.Name & "'!C3:C" & Lr & ",false))"), False, False)
sh1.Range("B:B").Clear
sh1.Range("B3").Resize(UBound(M) + 1, 1) = WorksheetFunction.Transpose(M)
End Sub

Thanks for your time.
I had to reverse sheet1 & sheet2 in your code, but it worked perfectly.

 

[kvsrinivasamurthy]

Sorry . for change in sheet name. Glad that your problem is solved.

 

[lyntanos]

Sorry . for change in sheet name. Glad that your problem is solved.

Does this code allow for more filtering to be added?
For example to find things that match both A1 in column K and A2 in column Q?
I hope that makes sense?

 

[lyntanos]

Does this code allow for more filtering to be added?
For example to find things that match both A1 in column K and A2 in column Q?
I hope that makes sense?

Still hoping to find an updated solution for this

 

[kvsrinivasamurthy]

Try this code. I have changed sheet numbers.

Sub GetValues()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Lr&
Dim M
Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")
Lr = sh1.Range("K" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(('" & sh1.Name & "'!K3:K" & Lr & "='" & sh2.Name & "'!A1)*('" & sh1.Name & _
            "'!Q3:Q" & Lr & "='" & sh2.Name & "'!A2),'" & sh1.Name & "'!C3:C" & Lr & ",false))"), False, False)
sh2.Range("B:B").Clear
If UBound(M) >= 0 Then sh2.Range("B3").Resize(UBound(M) + 1, 1) = WorksheetFunction.Transpose(M)
End Sub

 

[lyntanos]

Try this code. I have changed sheet numbers.

Sub GetValues()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim Lr&
Dim M
Set sh1 = Sheets("Sheet1"): Set sh2 = Sheets("Sheet2")
Lr = sh1.Range("K" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(('" & sh1.Name & "'!K3:K" & Lr & "='" & sh2.Name & "'!A1)*('" & sh1.Name & _
            "'!Q3:Q" & Lr & "='" & sh2.Name & "'!A2),'" & sh1.Name & "'!C3:C" & Lr & ",false))"), False, False)
sh2.Range("B:B").Clear
If UBound(M) >= 0 Then sh2.Range("B3").Resize(UBound(M) + 1, 1) = WorksheetFunction.Transpose(M)
End Sub

Perfect, thank you so much for your help.