Using dictionary to create vlookup

[tiredofit]

This is in Sheet1:

[TABLE="width: 72"]
<tbody>[TR]
[TD]SupplierID
[/TD]
[/TR]
[TR]
[TD="align: right"]1
[/TD]
[/TR]
[TR]
[TD="align: right"]2
[/TD]
[/TR]
[TR]
[TD="align: right"]3
[/TD]
[/TR]
</tbody>[/TABLE]

This is in Sheet2:

[TABLE="width: 301"]
<tbody>[TR]
[TD]SupplierID
[/TD]
[TD]SupplierName
[/TD]
[TD]Colour
[/TD]
[TD]IQ
[/TD]
[/TR]
[TR]
[TD="align: right"]3
[/TD]
[TD]Jim
[/TD]
[TD]Red
[/TD]
[TD="align: right"]10
[/TD]
[/TR]
[TR]
[TD="align: right"]1
[/TD]
[TD]Jack
[/TD]
[TD]Blue
[/TD]
[TD="align: right"]20
[/TD]
[/TR]
[TR]
[TD="align: right"]2
[/TD]
[TD]Jill
[/TD]
[TD]Green
[/TD]
[TD="align: right"]30
[/TD]
[/TR]
</tbody>[/TABLE]

This code work perfectly to do a vlookup:

Option Explicit
Sub test()
Dim DIC As Scripting.Dictionary
Set DIC = New Scripting.Dictionary
Dim LookupArray() As Variant
LookupArray = Worksheets("Sheet2").Range("a1").CurrentRegion.Value
With DIC
        
    Dim i As Long
    
    For i = 2 To UBound(LookupArray, 1)
        
        .Item(LookupArray(i, 1)) = LookupArray(i, 2)
        
        .Item(LookupArray(i, 2)) = LookupArray(i, 3)
    
        .Item(LookupArray(i, 3)) = LookupArray(i, 4)
    
    Next i
        
    Dim SourceArray() As Variant
    
    SourceArray = Worksheets("Sheet1").Range("a1").CurrentRegion.Resize(, 4).Value
    
    For i = 2 To UBound(SourceArray, 1)
        If .Exists(SourceArray(i, 1)) Then
        
            SourceArray(i, 2) = .Item(SourceArray(i, 1))
        
            SourceArray(i, 3) = .Item(SourceArray(i, 2))
        
            SourceArray(i, 4) = .Item(SourceArray(i, 3))
        
        End If
        
    Next i
End With
Worksheets("Sheet1").Range("a1").CurrentRegion.Resize(, 4).Value = SourceArray
Set DIC = Nothing
End Sub

What I am having trouble is if Sheet2 had an extra column like this:

[TABLE="width: 377"]
<tbody>[TR]
[TD]SupplierID
[/TD]
[TD]abc
[/TD]
[TD]SupplierName
[/TD]
[TD]Colour
[/TD]
[TD]IQ
[/TD]
[/TR]
[TR]
[TD="align: right"]3
[/TD]
[TD]a
[/TD]
[TD]Jim
[/TD]
[TD]Red
[/TD]
[TD="align: right"]10
[/TD]
[/TR]
[TR]
[TD="align: right"]1
[/TD]
[TD]b
[/TD]
[TD]Jack
[/TD]
[TD]Blue
[/TD]
[TD="align: right"]20
[/TD]
[/TR]
[TR]
[TD="align: right"]2
[/TD]
[TD]c
[/TD]
[TD]Jill
[/TD]
[TD]Green
[/TD]
[TD="align: right"]30
[/TD]
[/TR]
</tbody>[/TABLE]

I change the code to this:

Sub test2()
Dim DIC As Scripting.Dictionary
Set DIC = New Scripting.Dictionary
Dim LookupArray() As Variant
LookupArray = Worksheets("Sheet2").Range("a1").CurrentRegion.Value
With DIC
        
    Dim i As Long
    
    For i = 2 To UBound(LookupArray, 1)
        
        .Item(LookupArray(i, 1)) = LookupArray(i, 3)
        
        .Item(LookupArray(i, 2)) = LookupArray(i, 4)
    
        .Item(LookupArray(i, 3)) = LookupArray(i, 5)
    
    Next i
        
    Dim SourceArray() As Variant
    
    SourceArray = Worksheets("Sheet1").Range("a1").CurrentRegion.Resize(, 5).Value
    
    For i = 2 To UBound(SourceArray, 1)
        If .Exists(SourceArray(i, 1)) Then
        
            SourceArray(i, 3) = .Item(SourceArray(i, 1))
        
            SourceArray(i, 4) = .Item(SourceArray(i, 2))
        
            SourceArray(i, 5) = .Item(SourceArray(i, 3))
        
        End If
        
    Next i
End With
Worksheets("Sheet1").Range("a1").CurrentRegion.Resize(, 5).Value = SourceArray
Set DIC = Nothing
End Sub

but it doesn't return the colour column.

What is wrong?

Thanks

 

[Fluff]

Could you please explain what you want to do?

 

[tiredofit]

I am trying to use dictionaries to perform a vlookup.