Replacing a double cycle "for ... next" with a dictionary?

[Nelson78]

Hello everybody.

I'm tinkering with the following situation.

The starting point is the sheet "General": in column A a sequence of cities with duplicates (for example London 5 times); in column B a value for each city in column A.

The desired outcome is shown in the sheet "Detail":
for each city, all the encountered values displayed in row.


In origin the job was well done with a double cycle for ... next, but now the rows to elaborate are too much (about 20'000) for that kind of process.

For Each cell In Sheets("Detail").Range("A2:A" & lr)
    
    counter = 1

    For Each cell2 In Sheets("General").Range("A2:A" & lr)
    
        If cell.Value = cell2.Value Then            
            cell.Offset(0, counter).Value = cell2.Offset(0, 1).Value
            counter = counter + 1
        End If

    Next cell2

Next cell

So, I need something faster.

May be working with dictionary. But I need ideas to develop the code.
Thank's in advance.

Sub elaborate ()
   Dim InAry As Variant
   Dim i As Long

With Sheets("General")
      InAry = .Range("A2", .Range("A" & Rows.Count).End(xlUp).Offset(, 1)).Value2
  End With

   With CreateObject("scripting.dictionary")
  ....

 

[JEC]

Here a dictionary method

Sub jec()
 Dim sp(1000), ar, a, i As Long
 ar = Sheets("General").Range("A2", Sheets("General").Range("B" & Rows.Count).End(xlUp))
 
 With CreateObject("scripting.dictionary")
   For i = 1 To UBound(ar)
      a = .Item(ar(i, 1))
      If IsEmpty(a) Then a = sp
      a(0) = ar(i, 1)
      a(1000) = a(1000) + 1
      a(a(1000)) = ar(i, 2)
      .Item(ar(i, 1)) = a
    Next
    Sheets("Detail").Range("A2").Resize(.Count, 1000) = Application.Index(.items, 0, 0)
 End With
End Sub

 

[JvdV]

I'm uncertain about your setup, so I'm taking a wild guess here that the "Detail" page is empty beforehand? Well, here is a solution that would retrieve all values you wish for as text:

Sub Test()

Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("General")
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("Detail")
Dim lr As Long, x As Long
Dim arr1 As Variant, arr2 As Variant
Dim dict As Object: Set dict = CreateObject("SCripting.Dictionary")

lr = ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row
arr1 = ws1.Range("A2:B" & lr).Value

'Loop once to chuck it all into an dictionary;
For x = LBound(arr1) To UBound(arr1)
    If dict.Exists(arr1(x, 1)) Then
        dict(arr1(x, 1)) = dict(arr1(x, 1)) & "," & arr1(x, 2)
    Else
        dict(arr1(x, 1)) = arr1(x, 1) & "," & arr1(x, 2)
    End If
Next

'Loop twice to retrieve values from dictionary keys;
For x = LBound(arr1) To UBound(arr1)
    arr2 = Split(dict(arr1(x, 1)), ",")
    ws2.Cells(x + 1, 1).Resize(1, UBound(arr2) - LBound(arr2) + 1).Value = arr2
Next

End Sub

 

[Georgiboy]

Not a dictionary option but using var - unsure on speed:

Sub test()
    Dim wsG As Worksheet, wsD As Worksheet
    Dim rng As Range, var As Variant
    Dim col As New Collection
    Dim x As Long, i As Variant, c As Long
    Dim tRng As Range
    
    Set wsG = Sheets("General")
    Set wsD = Sheets("Detail")
    
    Set rng = wsG.Range("A1").CurrentRegion
    var = rng.Value
    
    For x = 2 To UBound(var)
        On Error Resume Next
            col.Add var(x, 1), CStr(var(x, 1))
        On Error GoTo 0
    Next x
    
    For Each i In col
        Set tRng = wsD.Range("A" & Rows.Count).End(xlUp).Offset(1)
        tRng = i
        For x = 2 To UBound(var)
            If var(x, 1) = i Then
                c = c + 1
                tRng.Offset(, c) = var(x, 2)
            End If
        Next x
        c = 0
    Next i
End Sub

 

[JEC]

Here is also a Power Query method

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    rename = Table.RenameColumns(Source,{{"number", "num"}}),
    cType = Table.TransformColumnTypes(rename,{{"num", type text}}),
    Grp = Table.Group(cType, {"city"}, {{"Count", each  Text.Combine([num],";"), type text}}),

    xMaxList =  List.Transform({
        1..List.Max(
         Table.AddColumn(Grp, "Custom", each 
            List.Count(
                Text.PositionOfAny([Count], {";"}, Occurrence.All)
            ))[Custom]
        ) +1
 
    }, each "V" & Text.From(_)),
   Split = Table.SplitColumn(Grp, "Count", Splitter.SplitTextByDelimiter(";", QuoteStyle.Csv), xMaxList)
in
   Split

Book1
	A	B	C	D	E	F	G	H
1	city	number			city	V1	V2
2	Londen	1			Londen	1	3
3	Paris	2			Paris	2	4
4	Londen	3			Rome	5	6
5	Paris	4
6	Rome	5
7	Rome	6
8
9
General