Loop through Autofilter Criteria VBA not starting with first available result?

Question

This script is used to filter column I data, copy it and move it to a new worksheet based on the first visible cell in I2 (header is I1). Afterwards, I would want to Loop it to go through the rest of the autofilter criteria without actually referencing anything, just running through the list. It seems to be working but it unselects all the data in Column I and doesn't name the sheet properly because the data results in blank rows. Can anyone help me?

I just need the code to do this:

Autofilter by column I (Manager), select all cells, create new worksheet, paste filtered manager data from raw data into that new worksheet, name worksheet based on first visible cell value in column I (manager name), and then loop through the rest of the filter list without having to reference manager names, just a Next kind of Looping feature until the whole list has been run-through.

   Sub Format()



   Set My_Range = Worksheets("Sheet1").Range("A1:I" & LastRow(Worksheets("Sheet1")))
   Set Name = FirstVisibleValue(ActiveSheet, 2, 9)

Cells.Select


 Do


    'Filter and set the filter field and the filter criteria :
    My_Range.AutoFilter Field:=9, Criteria1:=ActiveCell.Value



    'Add a new Worksheet
    Set WSNew = Worksheets.Add(After:=Sheets("Sheet1"))

    WSNew.Name = Name


        'Copy/paste the visible data to the new worksheet
        My_Range.Parent.AutoFilter.Range.Copy

        With WSNew.Range("A1")

            .PasteSpecial xlPasteValues
            Cells.Select
        End With





    'Close AutoFilter
    My_Range.Parent.AutoFilterMode = False

    'Restore ScreenUpdating, Calculation, EnableEvents, ....
    My_Range.Parent.Select
    ActiveWindow.View = ViewMode
    If Not WSNew Is Nothing Then WSNew.Select
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = CalcMode
    End With

Loop

End Sub


Function LastRow(sh As Worksheet)
    On Error Resume Next
    LastRow = sh.Cells.Find(What:="*", _
                            After:=sh.Range("A1"), _
                            Lookat:=xlPart, _
                            LookIn:=xlValues, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
    On Error GoTo 0
End Function

You have quite a lot of issues going on here, and number one I'd say is readability - I'd get rid of all those efficiencies you've added in (all the With Application bits), you definitely don't need those yet as you don't have working code, and it's taking up more than half of your macro. Also you need to explicitly reference your ranges (Workbooks("Book1").Worksheets("Sheet1").Range("A1:I" & LastRow(Worksheets("Sheet1")), etc. Using ActiveSheet and ActiveCell all over the place is going to mess you up. — dwirony
I just edited the code, can you help me with the identifying first visible cell in I2 in order to properly name the sheet? — user9632710

dwirony dwirony · Accepted Answer · 2018-04-13T14:07:57

Try this instead - cut down a lot of unnecessary things and cleaned it up a bit. To make sure we don't already have a worksheet for that manager, we use the UDF WorksheetExists().

Also I try to avoid Do/Loop loops when I can - just use a For loop for the entire column of I.

Option Explicit
Sub Format()

Dim sht As Worksheet, WSNew As Worksheet
Dim My_Range As Range
Dim i As Long, lastrow As Long

Set sht = ThisWorkbook.Worksheets("Sheet1")
lastrow = sht.Cells(sht.Rows.Count, "I").End(xlUp).Row
Set My_Range = sht.Range("A1:I" & lastrow)

For i = 2 To lastrow

    If WorksheetExists(sht.Range("I" & i).Value) = False Then

        Set WSNew = Worksheets.Add(After:=Sheets("Sheet1"))
        WSNew.Name = sht.Range("I" & i).Value

        My_Range.AutoFilter Field:=9, Criteria1:=sht.Range("I" & i).Value

        My_Range.Parent.AutoFilter.Range.Copy
        WSNew.Range("A1").PasteSpecial xlPasteValues

    End If

Next i

My_Range.Parent.AutoFilterMode = False
Application.CutCopyMode = False
End Sub
Function WorksheetExists(sName As String) As Boolean
    WorksheetExists = Evaluate("ISREF('" & sName & "'!A1)")
End Function

Loop through Autofilter Criteria VBA not starting with first available result?

1 Answers