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
