Excel VBA - Arrays instead of Index Match formula

TropicalMagic

New Member
Joined
Jun 19, 2021
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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:

1.png



Sample of Workbook 2's layout:

2.png


*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:


VBA Code:
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!
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.

Alex Blakenburg

MrExcel MVP
Joined
Feb 23, 2021
Messages
3,523
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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
 
Solution

TropicalMagic

New Member
Joined
Jun 19, 2021
Messages
43
Office Version
  1. 365
Platform
  1. Windows
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.

VBA Code:
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!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,163,407
Messages
5,831,436
Members
430,070
Latest member
Renske

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top