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!

 

[PietBom]

@offthelip,
Thanks for looking at it.
Did you do the steps as mentioned ?
Because then you would see that "Test 3" the Binary Search (VBA) is much faster than Vlookup

 

[PietBom]

@PietBom
We ask that you answer the question within the thread itself"

Sorry for doing it wrong.
This is my solution:

Function ZoekBinair(Zoek As String, Reeks As Range)
  n_Codes = Reeks.Rows.Count
  n_Checks = Int(1 + Log(n_Codes) / Log(2)) + 1
  x = Int(n_Codes / 2 + 0.5)
  Stap = x
  Gevonden = "No"
  For Z = 1 To n_Checks
    If StrComp(Zoek, Reeks.Cells(x, 1).Value, vbTextCompare) = 0 Then
      Gevonden = "Yes"
      GoTo Uit1
    End If
    Stap = Int(Stap / 2 + 0.5)
    If Stap < 1 Then Stap = 1
    If StrComp(Zoek, Reeks.Cells(x, 1).Value, vbTextCompare) = -1 Then
      x = x - Stap
      If x <= 1 Then x = 1
    End If
    If StrComp(Zoek, Reeks.Cells(x, 1).Value, vbTextCompare) = 1 Then
      x = x + Stap
      If x >= n_Codes Then x = n_Codes
    End If
  Next Z
Uit1:
  ZoekBinair = -999
  If Gevonden = "Yes" Then ZoekBinair = x

End Function

The formula should be: =ZoekBinair(lookupvalue, lookuprange)
The lookuprange needs to be sorted from A-Z

P.S. The hyperlink was for downloading the file to be able to do a benchmark test (which needed a few button clicks to prepare)

 

[offthelip]

You could speed up your binary search routine even more by using variant arrays instead of accessing the cells in a loop.
Undoubtedly doing a binary search is going to be faster than the linear search that my program does. However the greatest time saving come in minimising the number of accesses to the worksheet.
I would expect my linear search of variant arrays to be faster on average than a binary search that accesses cells in a range. However I have never found it necessary to do a binary search using variant arrays. By the time an excel spreadsheet gets to that size, it is probably time to do something about redesigning the whole system

 

[helpexcel]

I altered this code to try and make it work with my scenario, and it does but only by filling in 1 column and with the same info. How do I adjust it so that it looks for the value on Sheet 1 column B in Sheet 2 column A and then copies the data in columns B-R on sheet 2 and pastes it into the columns on sheet1 starting in column c?

THANKS!!!!!!

Sub testlookup()


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


'Data Dump Sheet
With Sheets("Sheet 2")
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
End With


'Values to look up & paste Sheet
With Sheets("Sheet 1")
lastrow2 = Cells(Rows.Count, "B").End(xlUp).Row
End With


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


End Sub

 

[PietBom]

@offthelip,
Thanks for your comments and advice.
Because I use it as a UDF it will take time to copy the search range to the array for ervery cell formula.
But my improvement lies in the reduction from 3 to 1 search action and then do the 3 IF checks
In my benchmark test it is 20% faster.
Did you test your code on in my benchmark test file ?

Function ZoekBinair(Zoek As String, Reeks As Range)
  n_Codes = Reeks.Rows.Count
  n_Checks = Int(1 + Log(n_Codes) / Log(2)) + 1
  x = Int(n_Codes / 2 + 0.5)
  Stap = x
  Gevonden = "No"
  For Z = 1 To n_Checks
    [COLOR=#ff0000]search_result[/COLOR] = StrComp(Zoek, Reeks.Cells(x, 1).Value, vbTextCompare)
    If search_result = 0 Then
      Gevonden = "Yes"
      GoTo Uit1
    End If
    Stap = Int(Stap / 2 + 0.5)
    If Stap < 1 Then Stap = 1
    If search_result = -1 Then
      x = x - Stap
      If x <= 1 Then x = 1
    End If
    If search_result = 1 Then
      x = x + Stap
      If x >= n_Codes Then x = n_Codes
    End If
  Next Z
Uit1:
  ZoekBinair = -999
  If Gevonden = "Yes" Then ZoekBinair = x
End Function

 

[offthelip]

@helpexcel
This should do it hopefully, although I haven't compiled or tested it. Note when using the "with" construct to load a varinat array you must put the reference within the with : end with bit. Also the way you reference cells you add the dot to show that it is with the "with"
Try this:

Sub testlookup()



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




'Data Dump Sheet
With Sheets("Sheet 2")
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
inarr = Range(.Cells(1, 1), .Cells(lastrow, 20))


End With




'Values to look up & paste Sheet
With Sheets("Sheet 1")
lastrow2 = .Cells(Rows.Count, "B").End(xlUp).Row
' load variant array with sercha variables
searcharr = Range(.Cells(1, 2), .Cells(lastrow2, 2))
' define an output aray
outarr = Range(.Cells(2, 3), .Cells(lastrow2, 19))
End With




On Error Resume Next
For i = 2 To lastrow2
For j = 2 To lastrow
Searchfor = searcharr(i, 1)
If inarr(j, 1) = Searchfor Then
 For kk = 2 To 18
outarr(i, kk - 1) = inarr(j, kk)
Exit For
End If
Next j
Next i
' writeout the output array
With Sheets("Sheet 1")
Range(.Cells(2, 3), .Cells(lastrow2, 19)) = outarr
End With




End Sub

 

[offthelip]

@PietBom
I did try running your tests but because I didn't know what I was looking at I really couldn't say what any results were. I couildn't see anything that seemed to time taken.
I believe your alternative for the Match function could be made significantly faster by this small modification. I would interest to know what improvement you find in the time.

Function ZoekBinair(Zoek As String, Reeks As Range)
  Dim inarr As Variant
  
  n_Codes = Reeks.Rows.Count
  inarr = Reeks.Value
  
  n_Checks = Int(1 + Log(n_Codes) / Log(2)) + 1
  x = Int(n_Codes / 2 + 0.5)
  Stap = x
  Gevonden = "No"
  For Z = 1 To n_Checks
    search_result = StrComp(Zoek, inarr(x, 1), vbTextCompare)
    If search_result = 0 Then
      Gevonden = "Yes"
      GoTo Uit1
    End If
    Stap = Int(Stap / 2 + 0.5)
    If Stap < 1 Then Stap = 1
    If search_result = -1 Then
      x = x - Stap
      If x <= 1 Then x = 1
    End If
    If search_result = 1 Then
      x = x + Stap
      If x >= n_Codes Then x = n_Codes
    End If
  Next Z
Uit1:
  ZoekBinair = -999
  If Gevonden = "Yes" Then ZoekBinair = x
End Function

 

[PietBom]

@offthelip,
I tested it in my test file:
Your version runs very long and I think I know why.
Because it is a UDF it will be calculated a 1000 times.
So a 1000 times the range of 1000.000 items will be copied to the array and then the binary search will run a bit faster.
My version ran 7,2 seconds while your version took 13m26s
The copying to the array lasts for ages.
It would be different if we used a VBA subroutine instead of a UDF. Then the range will be copied to the array only once and the searching would be faster.
You must realise that the binary search will need maximum 21 attemps. in an table of 1.048.576 items so an average of 10 or 11 for each of the 1000 search items, comes to 11.000 check events.
That is relatively little operations to the excel table and will not compensate the 1000 times copying 1.000.000 items to an array.

 

[helpexcel]

I'm getting the error "End If without block if". If played around with the code to try and fix it, but I'm stumped. Sorry!

 

[PietBom]

@helpexcel,
Did you copy the full code from #25 ?
At this forum you are not able to upload Excel files.
You could upload your example to e,g, dropbox and post the link to the thread
Then I could see why it is not working and fix it for you.
Or you could put a few screenshots here of your data tables and your VBA routine.