Excel VBA - Arrays instead of Index Match formula

[TropicalMagic]

Hi all,


I have 2 workbooks and would like to lookup row values using the common columns of Workbook 1's Column B and Workbook 2's Column F, match corresponding row values in Workbook 2's Column I, which is empty, to Workbook 1's Column Q.


The Index Match formula in Workbook2.Sheet(1).Columns("I:I")is given below:

INDEX(Workbook1.Sheet(1).Columns("Q:Q"), MATCH(Workbook2.Sheet(1).Columns("F:F"), Workbook1.Sheet(1).Columns("B:B"), 0))


However, since all columns have 10,000+ rows, the formula takes a long time to be applied by VBA.


Sample of Workbook 1's layout:

Sample of Workbook 2's layout:

*Note that the row values in Item_ID columns for Workbooks 1 and 2 may not be the same or sorted in order.



I tried using arrays to complete the task instead but am stuck, here is my code so far:

Dim Lastrow1 As Long

Lastrow1 = Workbooks("Workbook1").Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

Dim Lastrow2 As Long

Lastrow2 = Workbooks("Workbook2").Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row



InArray = Workbooks("UPS Carry Clear Brokerage Bid Activity.xlsx").Sheets(1).Range(Cells(1, 9), Cells(LASTROW1, 9))

Searchfor = Workbooks("Panorama Data.xlsx").Sheets(1).Range(Cells(2, 17), Cells(LASTROW2, 17))



Dim i As Long

For i = 1 To LASTROW2

If InArray(i, 17) = Searchfor Then

Workbooks("UPS Carry Clear Brokerage Bid Activity.xlsx").Sheets(1).Range(Cells(1, 9), Cells(LASTROW1, 9)) = InArray(i, 17)

Exit For

End If

Next i

Can anyone help me out?


Many thanks!

 

[Alex Blakenburg]

This thread seems to be not that different to your previous thread where Fluff provided you with a dictionay solution.

My coding is a bit more long winded than his but try this:
You will need to change the outSht name and srcSht name to whatever your sheet names are.
Also it assumes you have both workbooks open when you run it.

Sub GetOutCome()

    Dim outWb As Workbook
    Dim srcWb As Workbook
    Dim outSht As Worksheet
    Dim srcSht As Worksheet
    Dim srcArrItemID As Variant
    Dim srcArrOutcome As Variant
    Dim srcLastRow As Long
    Dim outArrItemID As Variant
    Dim outArrOutcome() As String
    Dim outLastRow As Long
    Dim i As Long, j As Long
    Dim dict As Object
    
'    XXX Change this to whatever the 2 workbook names are if you need to
'    It assumes you have both workbooks open
    Set outWb = Workbooks("UPS Carry Clear Brokerage Bid Activity.xlsx")
    Set srcWb = Workbooks("Panorama Data.xlsx")
    
    ' XXX Change the sheet names to what your sheetnames are
    Set outSht = outWb.Worksheets("Sheet2")
    Set srcSht = srcWb.Worksheets("Sheet1")
    
    srcLastRow = srcSht.Cells(Rows.Count, "B").End(xlUp).Row
    srcArrItemID = srcSht.Range("B2:B" & srcLastRow)
    srcArrOutcome = srcSht.Range("Q2:Q" & srcLastRow)
    
    outLastRow = outSht.Cells(Rows.Count, "F").End(xlUp).Row
    outArrItemID = outSht.Range("F2:F" & outLastRow)
    ReDim outArrOutcome(LBound(outArrItemID) To UBound(outArrItemID), 1 To 1)
    
    Set dict = CreateObject("Scripting.Dictionary")
    
    For i = 1 To srcLastRow - 1
        dict(srcArrItemID(i, 1)) = srcArrOutcome(i, 1)
    Next i
    
    For j = 1 To UBound(outArrItemID)
        If dict.exists(outArrItemID(j, 1)) Then
            outArrOutcome(j, 1) = dict(outArrItemID(j, 1))
        End If
    
    Next j
    
    outSht.Range("I2:I" & outLastRow) = outArrOutcome
    
End Sub

 

[TropicalMagic]

This thread seems to be not that different to your previous thread where Fluff provided you with a dictionay solution.

My coding is a bit more long winded than his but try this:
You will need to change the outSht name and srcSht name to whatever your sheet names are.
Also it assumes you have both workbooks open when you run it.

Sub GetOutCome()

    Dim outWb As Workbook
    Dim srcWb As Workbook
    Dim outSht As Worksheet
    Dim srcSht As Worksheet
    Dim srcArrItemID As Variant
    Dim srcArrOutcome As Variant
    Dim srcLastRow As Long
    Dim outArrItemID As Variant
    Dim outArrOutcome() As String
    Dim outLastRow As Long
    Dim i As Long, j As Long
    Dim dict As Object
   
'    XXX Change this to whatever the 2 workbook names are if you need to
'    It assumes you have both workbooks open
    Set outWb = Workbooks("UPS Carry Clear Brokerage Bid Activity.xlsx")
    Set srcWb = Workbooks("Panorama Data.xlsx")
   
    ' XXX Change the sheet names to what your sheetnames are
    Set outSht = outWb.Worksheets("Sheet2")
    Set srcSht = srcWb.Worksheets("Sheet1")
   
    srcLastRow = srcSht.Cells(Rows.Count, "B").End(xlUp).Row
    srcArrItemID = srcSht.Range("B2:B" & srcLastRow)
    srcArrOutcome = srcSht.Range("Q2:Q" & srcLastRow)
   
    outLastRow = outSht.Cells(Rows.Count, "F").End(xlUp).Row
    outArrItemID = outSht.Range("F2:F" & outLastRow)
    ReDim outArrOutcome(LBound(outArrItemID) To UBound(outArrItemID), 1 To 1)
   
    Set dict = CreateObject("Scripting.Dictionary")
   
    For i = 1 To srcLastRow - 1
        dict(srcArrItemID(i, 1)) = srcArrOutcome(i, 1)
    Next i
   
    For j = 1 To UBound(outArrItemID)
        If dict.exists(outArrItemID(j, 1)) Then
            outArrOutcome(j, 1) = dict(outArrItemID(j, 1))
        End If
   
    Next j
   
    outSht.Range("I2:I" & outLastRow) = outArrOutcome
   
End Sub

Brilliant! It worked as I intended!

Many thanks!

 

[Alex Blakenburg]

Thanks for letting me know. Glad I could help.