Hello,

I am working on the last step in a very long project and cannot figure out how to filter my data based on keys in a dictionary.

The data I am working with (in the ActiveSheet) has a list of names (in column 6). I want to add these names as keys in the dictionary and the corresponding location (in column 7) as the items. Then, I want to filter the data by each key in the dictionary, copy the filtered data, and paste it into another workbook. I have included the code I have so far. It seems to work exactly how I want as long as I'm not using the dictionary. What am I missing?

Thanks!!

Sub Step3_Create_Campaign_Files()

    Dim WS As Worksheet
    Dim FinalRow As Long
    Dim FinalCol As Long
    Dim i As Integer
    Dim j
    Dim k As Integer
    Dim dict As Object
    Dim r As Range
    Dim WBN As Workbook
        
    Set WS = ActiveSheet
    Set dict = CreateObject("scripting.dictionary")

    FinalRow = WS.Cells(Rows.Count, 1).End(xlUp).Row
    FinalCol = WS.Cells(1, Columns.Count).End(xlToLeft).Column

    If WS.AutoFilterMode = False Then
        WS.Cells(1, 1).Resize(1, FinalCol).AutoFilter
    End If

    WS.Cells(2, 6).Sort Key1:=WS.Cells(2, 6), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    
'   Puts all names into a dictionary
    For Each r In WS.Cells(2, 6).Resize(FinalRow - 1, 1)
        If Not dict.exists(r.Value) Then
            dict.Add r.Value, r.Offset(, 1).Value
        End If
    Next

'   Filters dataset for each key in dictionary, then copies and pastes values into new sheet
    For i = 1 To dict.Count
        WS.Cells(1, 1).Resize(FinalRow, FinalCol).AutoFilter Field:=6, Criteria1:=dict.keys(i)
        WS.AutoFilter.Range.Copy
        Set WBN = Workbooks.Add(template:=xlWBATWorksheet)
        Cells(1, 1).PasteSpecial Paste:=xlPasteValues
        ActiveWorkbook.SaveAs Filename:=CreateObject("WScript.Shell").specialfolders("Desktop") & "\" & dict.items(i) & " - " & dict.keys(i) & ".csv", FileFormat:=xlCSV
        ActiveSheet.Name = dict.keys(i)
        ActiveWorkbook.Close SaveChanges:=True
    Next

End Sub