Help with Vlookup alternative (storing values in array)

sharky12345

Well-known Member
Joined
Aug 5, 2010
Messages
3,404
Office Version
  1. 2016
Platform
  1. Windows
I'm trying to work out how to use a Vlookup alternative by storing values in an array but I can't get it to work, because I don't fully understand the elements.

I have 2 sheets with values in column R. I want to effectively search Sheet 2 for each value in sheet 1 then return the value from column S in sheet 2 to Sheet 1. Vlookup does it fine, but because there are thousands of rows it's taking a while, so I have been tinkering with this;

VBA Code:
Sub looking()
Dim arr1() As Variant
Dim arr2() As Variant
Dim arr3() As Variant

LastDataRow = Sheet15.Range("A65000").End(xlUp).row

arr1 = Sheet15.Range("R2:R" & LastDataRow).Value
arr2 = Range("A7:C500").Value

For i = 1 To 1405

arr3(i, 17) = WorksheetFunction.VLookup(arr1(i, 17), 17, False)
Next i

Sheet15.Range("T2:T1405").Value = arr3

End Sub

I know it's not right, and I'm not looking for someone to simply correct it because I'd rather someone explain the different elements of it so I can understand and work out how to adjust it to my needs?
 

Excel Facts

Format cells as date
Select range and press Ctrl+Shift+3 to format cells as date. (Shift 3 is the # sign which sort of looks like a small calendar).
Something that jumped out at me instantly was the missing lookup table (second argument of vlookup).

Depending on other things there can be ways to make a formula faster without vba. Setting up sheet 2 as a structured table. Using index and match instead of vlookup (this is based on what others have said, I've not tested it but I prefer index and match anyway). If sheet 2 is sorted in ascending order by column R then using approximate match twice is quicker than using exact match once.
 
Upvote 0
Below are line by line comments (in green), but from what I understand your aim is to speed up the process, but all you've done is embed the VLOOKUP within code, which can only add overhead in my opinion. I've not measured the effect, but would be surprised if it was quicker.

VBA Code:
Option Explicit 'include this to avoid variable creation 'on-the-fly'.
                'Note that this is the very first entry in the module.

Sub looking()
    '********************************************
    ' you have only defined the array variables, you should
    ' also define 'LastDataRow' and 'i'.
    '
    ' Its also worthwhile turning on the requirement to define all variables in preferences,
    ' this avoids mistyping a variable which creates a new variable that isn't useful.
    '
    '*************************
    
    
    Dim arr1() As Variant
    Dim arr2() As Variant
    Dim arr3() As Variant
    
    Dim LastDataRow As Double 'new variable declaration.
    Dim i As Double 'new variable declaration.
    
    
    LastDataRow = Sheet15.Range("A65000").End(xlUp).Row
    
    arr1 = Sheet15.Range("R2:R" & LastDataRow).Value
    arr2 = Range("A7:C500").Value 'this will only copy column 'A' to arr2, columns 'B' & 'C' will be ignored.
    
    For i = 1 To 1405 'why 1405 - it doesn't appear to be relevant to the other parameters/areas in the problem
    
        arr3(i, 17) = WorksheetFunction.VLookup(arr1(i, 17), 17, False)  ' vlookup is missing the area to search.
                                                                         ' 'arr1' is a single dimension array, the construct arr1(i,17) requires a multidimension array.
                                                                         ' It is worth indenting code between For/Next, If/Endif type statements to make them easier to read.
    Next i
    
    Sheet15.Range("T2:T1405").Value = arr3 ' thi simply doesn't work in my experience.

End Sub
 
Upvote 0
See if you can use/adapt something like this. I have not used a VLOOKUP approach.

VBA Code:
Sub looking_v2()
  Dim d As Object
  Dim a As Variant, b As Variant
  Dim i As Long
  
  With Sheets("Sheet2")
    a = .Range("R2", .Range("S" & Rows.Count).End(xlUp)).Value
  End With
  Set d = CreateObject("Scripting.Dictionary")
  d.CompareMode = 1
  For i = 1 To UBound(a)
    If Not d.Exists(a(i, 1)) Then d(a(i, 1)) = a(i, 2)
  Next i
  With Sheets("Sheet1")
    a = .Range("R2", .Range("R" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      b(i, 1) = d(a(i, 1))
    Next i
    'I wasn't quite sure where in Sheet1 you wanted the results?
    .Range("T2").Resize(UBound(b)).Value = b
  End With
End Sub
 
Upvote 0
Solution
Guys thanks to all for your input - Peter I've tried yours and it certainly looks promising, it certainly does the basics of what I need so can tinker with it.

Thank you all!
 
Upvote 0

Forum statistics

Threads
1,213,520
Messages
6,114,099
Members
448,548
Latest member
harryls

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
Back
Top