Hello,
I have over 800.000 rows so using Vlookup, Index , Match and Array formulas cause extreme slow performance on the file.
While searching i found VBA scripting dictionary method for lookup in a fast way.
The problem is that if the key has multiple value, it will not return every of them. It will just show 1 value (the value of last row with the key)
I need to write all values horizontally like in the 2nd picture (done by manually)
Could you please help me to tweak the code ?
[Blocked Image: https://i.ibb.co/xXd883j/1.png] [Blocked Image: https://i.ibb.co/f8NzBT7/3.png] [Blocked Image: https://i.ibb.co/1nsZ6LV/2.png]
Code
Sub DictionaryVLookup()
'Youtube video :https://www.youtube.com/watch?v=c7RNF4GIpAk
Dim x, x2, y, y2()
Dim dict2 As Object
Dim ws As Worksheet
Set ws1 = ThisWorkbook.Sheets("Liste")
Set ws2 = ThisWorkbook.Sheets("Siparis")
Set dict2 = CreateObject("Scripting.Dictionary")
lr = ws1.Cells(Rows.Count, "A").End(xlUp).Row
x = ws1.Range("A2:A" & lr).Value
x2 = ws1.Range("B2:B" & lr).Value
For i = 1 To UBound(x, 1)
dict2.Item(x(i, 1)) = x2(i, 1)
Next i
lr2 = ws2.Cells(Rows.Count, "A").End(xlUp).Row
y = ws2.Range("A2:A" & lr2).Value
ReDim y2(1 To UBound(y, 1), 1 To 1)
For i = 1 To UBound(y, 1)
If dict2.exists(y(i, 1)) Then
y2(i, 1) = dict2(y(i, 1))
Else
y2(i, 1) = "Bulunamadi"
End If
Next i
ws2.Range("D2:D" & lr2).Value = y2
'Secim iptal edildi.
'ws2.Range("D2:D" & lr2).Select
Set dict = Nothing
End Sub
