VBA Do Loop on Autofilter

[The_Rock]

Hi Folks
I have a field (Column K 'Letter') that contains Letters 1,3,4,6,7,8 (2 & 5 are missing).
What I am trying to do is limit to Letter 1, copy the results to a blank spreadsheet, save and then repeat for the next letter.

How can I modify the below so that it will loop through all the variables in the Autofilter?

 Selection.AutoFilter Field:=11, Criteria1:="Letter 1"

This is the code in it's entirety:

Sub Create_Letters()

Do
Sheets("FINAL").Select
Range("G1:AM" & Range("G" & Rows.Count).End(xlUp).Row).Select
    Selection.AutoFilter Field:=11, Criteria1:="Letter 1"
    Selection.Copy

    Workbooks.Add
    ActiveWindow.Zoom = 80
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Range("A2").Select
    ActiveWindow.FreezePanes = True

 'Save Template as per BP Name
    ThisFile = Range("E2").Value
    ActiveWorkbook.SaveAs "C:\Documents and Settings\My Documents\Work\Final Letters\" & Range("E2").Value & ".xls"
    ActiveWorkbook.Close savechanges:=False 'true
Loop Until IsEmpty(ActiveCell.Offset(1, 0))

End Sub

 

[The_Rock]

Hi Folks
Can anyone help with this?

Cheers

 

[John_w]

Here's one way which you can incorporate into your code (my test data is cells A1 to Z19):

    Dim i As Integer
    For i = 1 To 6
        Range("A1:Z19").Select
        Selection.AutoFilter Field:=11, Criteria1:="Letter " & Choose(i, 1, 3, 4, 6, 7, 8)
    Next

You say your Letters column is column K, however in your code:

Range("G1:AM" & Range("G" & Rows.Count).End(xlUp).Row).Select
    Selection.AutoFilter Field:=11, Criteria1:="Letter 1"

your range selection starts at G1, and the AutoFilter field is field 11, which is column Q (eleven columns from column G), which means that the filter is not filtering on column K.

 

[The_Rock]

Hi John
Many thanks for your reply.

Regarding Autofilter Field 11

your range selection starts at G1, and the AutoFilter field is field 11, which is column Q (eleven columns from column G), which means that the filter is not filtering on column K.

I have additional data in Columns A to F which I don't want to copy to the new sheet.
I've used the macro recorder to test the selection and it works on Column K


I have applied your logic to my code and have it working, where it is saving indiviual sheets.
Only issue I have now is that the 'Loop Until' statement is not working. I think it needs updating.
Can you provide any guidance? Once the macro has gone through the filter, it carries on to the first letter again.

Sub Create_Letters()

Do

Dim i As Integer
    For i = 1 To 6
    Sheets("FINAL").Select
    Range("G1:AM" & Range("G" & Rows.Count).End(xlUp).Row).Select
    Selection.AutoFilter Field:=11, Criteria1:="Letter " & Choose(i, 1, 3, 4, 6, 7, 8)
    Selection.Copy

    Workbooks.Add
    ActiveWindow.Zoom = 80
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    ActiveSheet.Paste
    Range("A2").Select
    ActiveWindow.FreezePanes = True

 'Save Template as per BP Name
    ThisFile = Range("E2").Value
    ActiveWorkbook.SaveAs "C:\Documents and Settings\Work\Final Letters\" & Range("E2").Value & ".xls"
    ActiveWorkbook.Close savechanges:=False
    Next i

Loop Until IsEmpty(ActiveCell.Offset(1, 0))

End Sub

Thanks in advance

 

[John_w]

Do you need the Do Loop now? Try taking it out.

 

[The_Rock]

That did the trick. Thanks a lot John!!