Sub Test()
Dim Dict As Object
Dim Data As Variant, Ky As Variant, Itm As Variant
Set Dict = CreateObject("Scripting.Dictionary")
Data = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
For Each Itm In Data
Dict(Itm) = Empty
Next Itm
For Each Ky In Dict.Keys()
'Do your filtering of each value here
Next Ky
End SubDict(Itm) = EmptySub FilterTest1()
ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = "temporary"
ActiveSheet.[A:A].Value = Worksheets("Criteria").[A:A].Value
Cells.RemoveDuplicates Columns:=Array(1)
<code>'for heading deletion</code>
Range("A1").EntireRow.Delete
Dim B As Integer
B = Cells.CurrentRegion.Rows.Count
With Sheets("Temporary")
Selection.End(xlDown).Select
End With
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
[COLOR=#006400]'need help from here[/COLOR]</code><code>[COLOR=#006400][/COLOR]
End SubWhen you put something in a dictionary you must add a Key and an associated Item. That line puts every entry in the column as a Key and 'Empty' (nothing really) as the Item. The Item could just as easily have been something like 1 (ie Dict(Itm) = 1) since the way you want to use the dictionary only involves the Keys, not the Items.
It is not clear quite what that means.
Try this in a copy of your workbook.
Sub CollateData()
Dim Dict As Object
Dim Data As Variant
Dim i As Long
'Set up the dictionary
Set Dict = CreateObject("Scripting.Dictionary")
'Read the data from cols A:B of sheet 'Criteria" into an array in memory
'This gives faster processing than going back to the worksheet to read each cell
With Sheets("Criteria")
Data = .Range("A1", .Range("B" & .Rows.Count).End(xlUp)).Value
End With
'Put all the column A values into the dictionary.
'They will only be added once and just append all the column B values with a separator
For i = 1 To UBound(Data)
Dict(Data(i, 1)) = Dict(Data(i, 1)) & Data(i, 2) & ";"
Next i
'Add the new sheet
Sheets.Add After:=Sheets(Sheets.Count)
With Sheets(Sheets.Count).Range("A1")
'Put all the dictionary Keys (col A values) and items (appended col B values) into this sheet
.Resize(Dict.Count, 2).Value = Application.Transpose(Array(Dict.Keys, Dict.Items))
'Use Text to Columns to split the appended col B values into separate columns
.CurrentRegion.Columns(2).TextToColumns DataType:=xlDelimited, Semicolon:=True
End With
End Sub
