Macro/VBA to compare two sheets and returns multiple results

[urskrishna18]

Hi, I am a beginner in writing macros.
I have 2 sheets, sheet1 and sheet2.
Sheet1 contains the lookup value in Column A (Col1) and Sheet2 contains the lookup array.
The requirement is lookup value in Column A in Sheet1 to be searched in Sheet2 and return the result of column B and Column C for all the matched values .
The returned values to be stored in Column C of Sheet1. Below are screenshots

Sheet1:

Col1	Col2	Col3
A	1​	<Result of matched values to be placed here>
B	2​
C	3​
D	4​

Sheet2:

Look1	Look2	Look3
A	A	1/28/2022​
B	A	1/28/2022​
A	A	1/28/2022​
C	A	1/28/2022​
D	I	1/28/2022​
B	I	1/28/2022​
A	I	1/28/2022​
E	A	1/28/2022​

I have tried the below VBA/Macro but the issue is it is only returning the last matched row instead of all the matched values:

Like for Value "A" in Sheet1.Col1 there are 3 values in Sheet2, i would require all 3 instead of just the last match value.

Code i managed to write:

Sub searchval()

Dim a()     As Variant
Dim str()   As String
Dim i       As Long
Const delim As String = "|"

Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

Set ws = Sheets("Sheet1")
    
With ws
    LC = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
    With Sheets("Sheet2")
        
        i = .Range("C" & .Rows.Count).End(xlUp).Row
        a = .Range("A1:C" & i).Value
        
        For i = LBound(a, 1) To UBound(a, 1)
            dic(a(i, 1)) = a(i, 2) & delim & a(i, 3)  
        Next i
        
    End With

    With Sheets("Sheet1")
    
        For i = 2 To .Range("A" & .Rows.Count).End(xlUp).Row
        
            str = Split(dic(.Range("A" & i).Value), delim)
           
            .Cells(i, LC ).Resize(, 1).Value = str
            
            Erase str
            
        Next i
        
    End With

Set dic = Nothing
Erase a

End Sub

Can someone please help me here?

 

[Marc L]

Hi,​

​

should be easier to help with a sample of a before state worksheet and an expected result worksheet with the exact layout …​

 

[urskrishna18]

Hi Marc, Thanks for the response. I have attached a sample sheet as per my explanation above.

In the sample excel, "Sheet1" and "Sheet2" contains data and macro is present to get the result. There is another sheet "Expected", where i tried to explain the expected result.

 

[urskrishna18]

Hi Marc, Thanks for the response. I have attached a sample sheet as per my explanation above.

In the sample excel, "Sheet1" and "Sheet2" contains data and macro is present to get the result. There is another sheet "Expected", where i tried to explain the expected result.

Sorry Marc i am not able to attach the sheet, will try any other way

 

[urskrishna18]

Hi,​

​

should be easier to help with a sample of a before state worksheet and an expected result worksheet with the exact layout …​

Hi Marc, Thanks for the response. I have attached a sample sheet as per my explanation above.

In the sample excel, "Sheet1" and "Sheet2" contains data and macro is present to get the result. There is another sheet "Expected", where i tried to explain the expected result.

Find the sheet here: sample_mrxl.xlsm

 

[Marc L]

​

According to your attachment the item B has two values in Sheet2 so Harik explain why it has only a single value in the expected result ?‼​

 

[urskrishna18]

​

According to your attachment the item B has two values in Sheet2 so Harik explain why it has only a single value in the expected result ?‼​

Hi Marc, I just gave an example for one (for A) in the expected result, but the same applies for all such cases. So in the expected result Item B also should get those 2 values. Apologies for not including it in the sheet.

 

[Marc L]

According to your attachment and Excel / VBA basics a VBA demonstration for a beginner starters :​

Sub Demo1()
    Dim S, W, V, L&, R
        S = Sheet2.UsedRange.Columns("A:B").Value2
    With Sheet1.Range("A2:A" & Sheet1.UsedRange.Rows.Count)
        W = .Value2
        ReDim V(1 To UBound(W), 0)
    For L = 2 To UBound(S)
        R = Application.Match(S(L, 1), W, 0)
        If IsNumeric(R) Then V(R, 0) = V(R, 0) & IIf(V(R, 0) > "", vbLf, "") & S(L, 2)
    Next
       .Columns(3).Value2 = V
    End With
End Sub

 

[urskrishna18]

According to your attachment and Excel / VBA basics a VBA demonstration for a beginner starters :​

Sub Demo1()
    Dim S, W, V, L&, R
        S = Sheet2.UsedRange.Columns("A:B").Value2
    With Sheet1.Range("A2:A" & Sheet1.UsedRange.Rows.Count)
        W = .Value2
        ReDim V(1 To UBound(W), 0)
    For L = 2 To UBound(S)
        R = Application.Match(S(L, 1), W, 0)
        If IsNumeric(R) Then V(R, 0) = V(R, 0) & IIf(V(R, 0) > "", vbLf, "") & S(L, 2)
    Next
       .Columns(3).Value2 = V
    End With
End Sub

Hi Marc, Thank you for the above. This code is working but one more ask on the same and one issue, if you can help me:

Ask: The above code prints the value in the column specified (always the same column), but can you help me in assigning the result to the last column. Because the tool that i am working on runs every day, so it needs to append the result to the last column. The code that i copied above (from my workings) handles it but not sure how the value in your code can be assigned to that.

Expected result
		Today's Date	Today's Date	Next day's Date	Next day's Date
Col1	Col2	Look2	Look3	Look2	Look3
A	1	A A I	1/28/2022 1/28/2022 1/28/2022	A A I	1/28/2022 1/28/2022 1/28/2022
B	2	I	1/28/2022	I	1/28/2022
C	3	A	1/28/2022	A	1/28/2022
D	4	I	1/28/2022	I	1/28/2022

Apologies i could have been clear on the expected result before, i thought i can give it a try but i am not able to crack it

Issue: I observed that when Sheet1.Range contains only one row, i am getting "Type mismatch" error at " ReDim V(1 To UBound(W), 0)", not sure why?

like this:

Col1	Col2	Col3
A	1	I

 

[Marc L]

No such issue on my side …​