Vlookup VBA Alternative

[helpexcel]

Is there a quicker way to use vlookup with VBA. I have a lot of data that I would just use vlookup with, across multiple sheets. Hoping there's a way to speed things up. THANKS!

 

[offthelip]

I have annotated the code to try and explain how it is working, I also made a couple of changes , one to check for blank cells and skip the check for those. Also i have put a limit on the number of msgboxs that it will produce. I also corrected the looping to time up with the description.

cnt = 1

Dim txt As String


' The assumption is that the array of data which is the target of the searching is on
'"sheet1"


With Worksheets("sheet1")
' this finds the last row with data in it in column B of sheet 1
lastrow = .Cells(Rows.Count, "B").End(xlUp).Row
' this loads all the data from the worksheet from columns 1 to 36 (columns A to AJ)
' and rows 1 to the last row which has data in it as found in column B
inarr = Range(.Cells(1, 1), .Cells(lastrow, 36))
End With






' The assumption is that there is a list of data in column A on sheet2 where
' you want to find the matching values in column B of sheet1 and then pick data fromthe same row in sheet 1


With Worksheets("sheet2")
' this finds the last row with data in it in column A of sheet2


lastrow2 = .Cells(Rows.Count, "A").End(xlUp).Row
' this loads all the data in column A of sheet2 into a variant array
search4 = Range(.Cells(1, 1), .Cells(lastrow2, 1))
End With




' This outer loop goes down each row column A of sheet 2
' Note i have swapped the two loops round becasuse it will work better that way
For j = 1 To lastrow2
' this inner loop goes down each row of sheet 1
 For i = 1 To lastrow
 ' i Have added an extra if here to chekc for blank cells
  If inarr(i, 2) <> "" Then
  ' this is the critical check: it checks in turn each value in column A of sheet 2
  ' which is in search4 (j,1)
  ' It checks this against each value in column B of sheet 1 , this is in
  ' inarr(i,2). (i is the row number and 2 is the column number )
  If search4(j, 1) = inarr(i, 2) Then
   ' if they are equal, then  i will give you the row number on sheet 1 with all the data for that row
   ' Since we loaded all the columns from sheet 1 into the variant array
   ' you can access the values directly by referring to the variant arary inarr.
   ' for example inarr(i,1) will be the value from column A , inarr(i,36)  will be column AJ
   ' inarr(i,10) will be column 10 ,etc
     For k = 3 To 36
      ' do what ever you want to do with the values from C to AJ here
      txt = inarr(i, k)
      If cnt < 6 Then
      MsgBox (txt)
      cnt = cnt + 1
      End If
     Next k
   End If
  End If
 Next i
 Next j

Use the debug faciltiy to put a breakpoint in the code at the start of the outer loop. then look in the local window and check what data you have got in the two vaarinat array inarr and search4. check that you have got the corrct data in them. thne put a breakpoiont on the " if " line and check that that is working properly.

 

[offthelip]

I forgot to tell you about the big advantage of doing Vlookups like this in VBA is that is so simple to do a multicolumn check which is not possible with vlookup. E.g you wanted to do a lookup on using two columns, one with first name and the second with surname.
the if statements would look like this:

if search4(j,1)= inarr(i,2) and  search4(j,2)= inarr(i,3) then

 

[PietBom]

I uploaded an Excel file with some benchmark tests.
https://www.dropbox.com/s/p1yn2ewttdc7n6o/Binair_Zoeken3g.xlsb?dl=0
1. Go to Sheet1 and click button [Generate 1000.000 items]
2. Then click button [Remove duplicates]
3. Then click button [Sort Data]
4. Go to Sheet2 there you will find a table with 1000 records which need to be looked up in the 1000.000 records table
5. Click button [Generate 1000 Codes]
6. Click buttons 1 to 6 to test: Match&Index, Vlookup, Binary Search, Sumif, Double (sorted) Index Search

Remark1: if you save this file it will grow from 118k to 25Mb (it has the extension .xlsb as a binary file with VBA code)
Remark2: when you have tested please give some feedback here.

 

[Eric4545]

offthelip, your original code does a simple lookup with only one lookup value and one result in Cells E1 and F1 respectively. I modified your code as follows in order to lookup and return many search values in column E.

The problem I'm now seeing is this becomes a long calculation (probably due to my modifications). In the sample I ran against this code I have 256350 rows in columns A and B. I have 2685 rows in column E that I need to perform the lookup against. Turning off calculations, screen updating etc. This ran in 4m 30s.

Is there anyway to improve that?
By directly inputting the value into each cell did I ruin the efficiency of this method?

If my understanding is correct building a second array that has my lookup value and my result in the memory would be more efficient. Then taking the result column and applying it to my excel sheet would be fastest. Is that true? If so, coding that is beyond by capabilities and I would be grateful for some help if you can spare the time.

Thank you

Sub testlookup()


Dim lastrow, lastrow2, i As Long
Dim Searchfor, j, inarr As Variant


lastrow = Cells(Rows.Count, "A").End(xlUp).Row
lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 2))


On Error Resume Next
For i = 2 To lastrow2
 For j = 2 To lastrow
 Searchfor = Cells(i, 5)
 If inarr(j, 1) = Searchfor Then
  Cells(i, 6) = inarr(j, 2)
  Exit For
 End If
 Next j
Next i


End Sub

Yes there is a much faster way of doing it and that is using variant arrays. The main reason this is faster is because VBA is very slow at accessing the worksheet, so the way to speed up VBA is to minimise the number of accesses to any of the worksheets. One thing to realise is that the time taken to load a singe cell into VBa is almost the same as the time taken to load a large range of data into VBa. So to speed up the process of looking for a match DON'T use the EXCEL functions operating on ranges on the worksheet , load all the data in memory usng variant arrays and then do the searching in memory . The code below does a very simple VLookup equivalent. I have two lists of data in column A and B I have the item I want to match against column A in Cell E1, it puts the results in F1
This code will be extremely fast even over 10000 rows.

lastrow = Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(Cells(1, 1), Cells(lastrow, 2))
Searchfor = Cells(1, 5)
For i = 1 To lastrow
 If inarr(i, 1) = Searchfor Then
  Cells(1, 6) = inarr(i, 2)
  Exit For
 End If
Next i

Obviously without more details of your exact layout I can't give any more detailed help

 

[offthelip]

The answer is yes, accessing the cell in an indexed loop does slow it down enormously, I have needed to post the following paragraph so many times on this forum and others that I keep a copy of it ready to go:
One of the main reasons that Vba is slow is the time taken to access the worksheet from VBa is a relatively long time.
To speed up vba the easiest way is to minimise the number of accesses to the worksheet. What is interesting is that the time taken to access a single cell on the worksheet in vba is almost identical as the time taken to access a large range if it is done in one action.
So instead of writing a loop which loops down a range copying one row at a time which will take along time if you have got 50000 rows it is much quicker to load the 50000 lines into a variant array ( one worksheet access), then copy the lines to a variant array and then write the array back to the worksheet, ( one worksheet access for each search that you are doing),
I have a simple rule for fast VBA: NEVER ACCESS THE WORKSHEET IN A LOOP.

So your modifications added 2 times 256350 accesses the spreadsheet, so I am quite surprised that it only took 4 minutes or so. I have done a couple of very minor modifications to your code to load all the variables into variant arrays and define a variant array for the output so that there ar NO accesses to the worksheet in the loop. I expect this to take less than 1 second

Sub testlookup()



Dim lastrow, lastrow2, i As Long
Dim Searchfor, j, inarr As Variant




lastrow = Cells(Rows.Count, "A").End(xlUp).Row


lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row


inarr = Range(Cells(1, 1), Cells(lastrow, 2))
' load variant array with sercha variables
searcharr = Range(Cells(1, 5), Cells(lastrow, 5))
' define an output aray
outarr = Range(Cells(1, 6), Cells(lastrow, 6))
On Error Resume Next
For i = 2 To lastrow2
 For j = 2 To lastrow
 Searchfor = searcharr(i, 1)
 If inarr(j, 1) = Searchfor Then
  outarr(i, 1) = inarr(j, 2)
  Exit For
 End If
 Next j
Next i
' writeout the output array
Range(Cells(1, 6), Cells(lastrow, 6)) = outarr






End Sub

 

[offthelip]

I realised there was a slight error in my code which wouldn't stop it working but make it very slightly slower( cut and paste!!)
This corrects it:

Sub testlookup()





Dim lastrow, lastrow2, i As Long
Dim Searchfor, j, inarr As Variant








lastrow = Cells(Rows.Count, "A").End(xlUp).Row




lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row




inarr = Range(Cells(1, 1), Cells(lastrow, 2))
' load variant array with sercha variables
searcharr = Range(Cells(1, 5), Cells(lastrow2, 5))
' define an output aray
outarr = Range(Cells(1, 6), Cells(lastrow2, 6))
On Error Resume Next
For i = 2 To lastrow2
 For j = 2 To lastrow
 Searchfor = searcharr(i, 1)
 If inarr(j, 1) = Searchfor Then
  outarr(i, 1) = inarr(j, 2)
  Exit For
 End If
 Next j
Next i
' writeout the output array
Range(Cells(1, 6), Cells(lastrow, 6)) = outarr












End Sub

 

[Eric4545]

Amazing. This works great. Thank you very much for the help, this will really speed up some clunky macros I've written in the past. A slight change to your code on the last line where it should be lastrow2 rather than lastrow.

' writeout the output array
Range(Cells(1, 6), Cells(lastrow2, 6)) = outarr

As a sidenote: I only got my earlier code down to 4m 30s because of the helper functions below.

Credit to the author at the link below:
https://stackoverflow.com/questions...lete-rows-containing-a-value-in-less/30959316

Option Explicit


Public Sub FastWB(Optional ByVal opt As Boolean = True)
    With Application
        .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
        .DisplayAlerts = Not opt
        .DisplayStatusBar = Not opt
        .EnableAnimations = Not opt
        .EnableEvents = Not opt
        .ScreenUpdating = Not opt
    End With
    FastWS , opt
End Sub


Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _
                  Optional ByVal opt As Boolean = True)
    If ws Is Nothing Then
        For Each ws In Application.ActiveWorkbook.Sheets
            EnableWS ws, opt
        Next
    Else
        EnableWS ws, opt
    End If
End Sub


Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean)
    With ws
        .DisplayPageBreaks = False
        .EnableCalculation = Not opt
        .EnableFormatConditionsCalculation = Not opt
        .EnablePivotTable = Not opt
    End With
End Sub


Public Function GetMaxCell(Optional ByRef Rng As Range = Nothing) As Range


    'Returns the last cell containing a value, or A1 if Worksheet is empty


    Const NONEMPTY As String = "*"
    Dim lRow As Range, lCol As Range


    If Rng Is Nothing Then Set Rng = Application.ActiveWorkbook.ActiveSheet.UsedRange
    If WorksheetFunction.CountA(Rng) = 0 Then
        Set GetMaxCell = Rng.Parent.Cells(1, 1)
    Else
        With Rng
            Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                        After:=.Cells(1, 1), _
                                        SearchDirection:=xlPrevious, _
                                        SearchOrder:=xlByRows)
            If Not lRow Is Nothing Then
                Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                            After:=.Cells(1, 1), _
                                            SearchDirection:=xlPrevious, _
                                            SearchOrder:=xlByColumns)


                Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
            End If
        End With
    End If
End Function

I realised there was a slight error in my code which wouldn't stop it working but make it very slightly slower( cut and paste!!)
This corrects it:

Sub testlookup()





Dim lastrow, lastrow2, i As Long
Dim Searchfor, j, inarr As Variant








lastrow = Cells(Rows.Count, "A").End(xlUp).Row




lastrow2 = Cells(Rows.Count, "E").End(xlUp).Row




inarr = Range(Cells(1, 1), Cells(lastrow, 2))
' load variant array with sercha variables
searcharr = Range(Cells(1, 5), Cells(lastrow2, 5))
' define an output aray
outarr = Range(Cells(1, 6), Cells(lastrow2, 6))
On Error Resume Next
For i = 2 To lastrow2
 For j = 2 To lastrow
 Searchfor = searcharr(i, 1)
 If inarr(j, 1) = Searchfor Then
  outarr(i, 1) = inarr(j, 2)
  Exit For
 End If
 Next j
Next i
' writeout the output array
Range(Cells(1, 6), Cells(lastrow, 6)) = outarr












End Sub

 

[PietBom]

I uploaded an Excel file with some benchmark tests.
https://www.dropbox.com/s/p1yn2ewttdc7n6o/Binair_Zoeken3g.xlsb?dl=0

Could anybody download this Excel file ?

 

[offthelip]

@PietBom
I downloaded your file and I had a look at it, but I am not sure what you trying to show. I would always use VBA to do that sort of thing because it is always going to be at least as fast and it won't increase the recalculation time. I only use Vlookup , Match and index, etc if there only a few items that need it.

 

[Fluff]

@PietBom
If you are going to provide a solution, please post it to the thread, rather than uploading a file.
From Rule#4
"Likewise, please do not answer questions by creating solutions elsewhere and then referencing those solutions via file links. We ask that you answer the question within the thread itself"