Advertisement
YasserKhalil2019

T4201_Extract Unique In Two Columns Dictionary Split Trick

Oct 25th, 2019
140
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 0.75 KB | None | 0 0
  1. https://excel-egy.com/forum/t4201
  2. ---------------------------------
  3.  
  4. Sub Extract_Unique_In_Two_Columns_Dictionary_Split_Trick()
  5. Dim a, x, b(), key, i As Long
  6.  
  7. a = Worksheets(1).Range("B5:C" & Worksheets(1).Cells(Rows.Count, 2).End(xlUp).Row).Value2
  8.  
  9. With CreateObject("Scripting.Dictionary")
  10. For i = 1 To UBound(a)
  11. .item(a(i, 1) & "~" & a(i, 2)) = .item(a(i, 1) & "~" & a(i, 2))
  12. Next i
  13. i = 1
  14. ReDim b(1 To .Count, 1 To 2)
  15.  
  16. For Each key In .Keys
  17. x = Split(key, "~")
  18. b(i, 1) = x(0)
  19. b(i, 2) = x(1)
  20. i = i + 1
  21. Next key
  22. End With
  23.  
  24. With Worksheets(2)
  25. .Range("B5").Resize(UBound(b), 2) = b
  26. End With
  27. End Sub
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement