VBA Array instead of Vlookup

[helpexcel]

Hi,

This is making me nuts. I have directions and still can't make this work.
I'm trying to replace this calc: Vlookup(V3,Worksheet!$G$4:$J$10,4,0)

So want to lookup the value in row V of sheet2, the lookup range is on worksheet G4:J10.
If sheet2 column V = worksheet column G, then place worksheet column J in sheet2 column W.

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


'Data Dump Sheet
With Sheets("Sheet2")
lastrow = .Cells(Rows.Count, "G").End(xlUp).Row
inarr = Range(.Cells(3, 22), .Cells(lastrow, 22))
End With


'Values to look up & paste Sheet
With Sheets("Worksheet")
lastrow2 = .Cells(Rows.Count, "G").End(xlUp).Row
' load variant array with sercha variables
searcharr = Range(.Cells(4, 7), .Cells(lastrow2, 10))
' define an output aray
outarr = Range(.Cells(4, 10), .Cells(lastrow, 10))
End With


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

 

[JackDanIce]

Try:

Sub Try()

    Dim x       As Long
    Dim arr()   As Variant
    Dim dic     As Object: Set dic = CreateObject("Scripting.Dictionary")
    
    'Read look up table into array
    With Sheets("Worksheet")
        x = .Cells(.Rows.Count, 7).End(xlUp).Row
        arr = .Cells(4, 7).Resize(x - 3, 4).Value
    End With
    
    'Map lookup table into dictionary
    For x = LBound(arr, 1) To UBound(arr, 1)
        dic(arr(x, 1)) = arr(x, 4)
    Next x
    Erase arr
    
    With Sheets("Sheet2")
        x = .Cells(.Rows.Count, 7).End(xlUp).Row
        'Read input values into array
        arr = .Cells(4, 7).Resize(x - 3).Value
        
        'Iterate array through dictionary to find matches and items
        For x = LBound(arr, 1) To UBound(arr, 1)
            If dic.exists(arr(x, 1)) Then
                'Replace key with item if exists
                arr(x, 1) = dic(arr(x, 1))
            Else
                'If does not exist, clear
                arr(x, 1) = vbNullString
            End If
        Next x
        
        'Output array to J4
        .Cells(4, 10).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
    End With
    
    Erase arr
    Set dic = Nothing
    
End Sub

 

[helpexcel]

thanks!

Couple of questions

'Does this load the values to be looked up?
With Sheets("Sheet2")
x = .Cells(.Rows.Count, 7).End(xlUp).Row
'Read input values into array
arr = .Cells(4, 7).Resize(x - 3).Value


'I changed this to .Cells(3,23) I want the lookup value placed in column W on sheet2

'Output array to J4
.Cells(4, 10).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
</pre>

 

[helpexcel]

I got it to work. thanks!! Still not sure I fully understand it...

Here's the code that worked.
Sub Try()


Dim x As Long
Dim arr() As Variant
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")

'Read look up table into array
With Sheets("Worksheet")
x = .Cells(.Rows.Count, 7).End(xlUp).Row
arr = .Cells(4, 7).Resize(x - 3, 4).Value
End With

'Map lookup table into dictionary
For x = LBound(arr, 1) To UBound(arr, 1)
dic(arr(x, 1)) = arr(x, 4)
Next x
Erase arr

With Sheets("Sheet2")
x = .Cells(.Rows.Count, 22).End(xlUp).Row
'Read input values into array
arr = .Cells(3, 22).Resize(x - 5).Value

'Iterate array through dictionary to find matches and items
For x = LBound(arr, 1) To UBound(arr, 1)
If dic.exists(arr(x, 1)) Then
'Replace key with item if exists
arr(x, 1) = dic(arr(x, 1))
Else
'If does not exist, clear
arr(x, 1) = vbNullString
End If
Next x

'Output array to J4
.Cells(3, 23).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End With

Erase arr
Set dic = Nothing

End Sub

 

[JackDanIce]

Glad you managed to adjust and make work. I added some more comments, if it helps:

Sub Try()


Dim x As Long
'Array variable
Dim arr() As Variant
'Dictionary object
Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")


'Read look up table into array
With Sheets("Worksheet")
    x = .Cells(.Rows.Count, 7).End(xlUp).Row
    'Range(G4:Jx where x is last row in column G)
    arr = .Cells(4, 7).Resize(x - 3, 4).Value
End With


'Map lookup table into dictionary
For x = LBound(arr, 1) To UBound(arr, 1)
    'dic(match column) = return column
    dic(arr(x, 1)) = arr(x, 4)
Next x
'Clear array contents
Erase arr


With Sheets("Sheet2")
    x = .Cells(.Rows.Count, 22).End(xlUp).Row
    'Read input values from column V into array
    'Range(V3:Vx, where x is last row in column V)
    arr = .Cells(3, 22).Resize(x - 5).Value


    'Iterate array through dictionary to find matches and items
    For x = LBound(arr, 1) To UBound(arr, 1)
    'If value from V3:Vx is found in dictionary then
        If dic.exists(arr(x, 1)) Then
        'Replace key with item if exists
            arr(x, 1) = dic(arr(x, 1))
        Else
            'If does not exist, clear
            arr(x, 1) = vbNullString
        End If
    Next x


    'Output array to W3
    .Cells(3, 23).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End With


'Clear variables
Erase arr
Set dic = Nothing


End Sub

 

[helpexcel]

Is there a way to add another lookup table? Meaning depending on the value in column X, the lookup table would be different?

If Column X = 1234

'Read look up table into array
With Sheets("Worksheet")
x = .Cells(.Rows.Count, 7).End(xlUp).Row
'Range(G4:Jx where x is last row in column G)
arr = .Cells(4, 7).Resize(x - 3, 4).Value
End With



If Column X = 5678

'Read look up table into array
With Sheets("Worksheet")
x = .Cells(.Rows.Count, 11).End(xlUp).Row
'Range(G4:Jx where x is last row in column G)
arr = .Cells(4, 11).Resize(x - 3, 4).Value
End With</pre>