Autofilter Loop

[Shailender]

Hello All,

Need a help on the Autofilter Loop.

Please find the enclosed excel sheet with the criteria i was looking for. Refer to Sheet2 for the question and the code please refer to Module1.

Hope the question is clear on the sheet2.

Thank you

 

[Shailender]

Can someone help me out...?

 

[Chihiro]

Your data structure isn't ideal for autofilter. Autofilter is meant for flat table structure with contiguous range of non-blank cells... which your data is not.

For instance, if filter for "Vijay" is applied to entire Column A. You will only see row with "Vijay" and any blank cells that may belong to "Vijay" will be filtered out, including dates tracked in Column H.

As well, autofilter generally don't need loops (unless you are copying filtered info to another sheet).

I'd strongly suggest changing your data structure. And also, manually construct what the outcome of your filter operation should look like.

 

[Shailender]

Hey, Chihiro thank you for the reply. I have the structured data with all blanks filled. Here i just given an example. I want to do the autofill through all names everyday through loop. Hope my question is clear.

 

[Chihiro]

But you have dates in separate row. Not in line with each line item.

If you have structured data, can you upload what it looks like? Example should reflect your actual data structure.

Did you test your code on the sample? It will error out due to how it's structured.

 

[Shailender]

Chihiro, Please refer to the attached Sheet.

Thank you!

 

[Chihiro]

What is it that you are trying to accomplish here?

Do you want to export each date to separate sheet (with info that meet criteria 1 & 2)?

 

[Chihiro]

Here, try this.

Sub test()
Dim dateCellsDict As Object
Dim lRow As Long, i As Integer, j As Integer
Dim cel As Range
Dim ws As Worksheet, oWs As Worksheet
i = 1
Set oWs = ThisWorkbook.Worksheets("Sheet1")
Set dateCellsDict = CreateObject("Scripting.Dictionary")
lRow = oWs.Cells(Rows.Count, 1).End(xlUp).Row

Application.ScreenUpdating = False
ResetFilter oWs
With oWs.Range("H1:H" & lRow)
    .AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "9/30/2016")
    For Each cel In .Offset(1, 0).SpecialCells(xlCellTypeVisible)
        dateCellsDict.Add Item:=cel, Key:=i
        i = i + 1
    Next
End With


For j = 1 To dateCellsDict.Count
    ResetFilter oWs
    Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
    If j <> dateCellsDict.Count Then
        With oWs.Range(dateCellsDict.Item(j).Offset(0, -7), dateCellsDict.Item(j + 1).Offset(-2, 4))
            .AutoFilter Field:=1, Criteria1:=Application.Transpose(Range("lstName")), Operator:=xlFilterValues
            .AutoFilter Field:=11, Criteria1:=Array("Offshore - MPI", "Offshore MPI", "US MPI"), Operator:=xlFilterValues
            Sheet1.Range("A1:L1").Copy ws.Cells(1, 1)
            .SpecialCells(xlCellTypeVisible).Copy ws.Cells(2, 1)
            ws.Columns.AutoFit
            ws.Name = Format(dateCellsDict.Item(j).Value, "mmddyyyy")
        End With
    Else
        With oWs.Range(dateCellsDict.Item(j).Offset(0, -7), oWs.Range("L" & lRow))
            .AutoFilter Field:=1, Criteria1:=Application.Transpose(Range("lstName")), Operator:=xlFilterValues
            .AutoFilter Field:=11, Criteria1:=Array("Offshore - MPI", "Offshore MPI", "US MPI"), Operator:=xlFilterValues
            Sheet1.Range("A1:L1").Copy ws.Cells(1, 1)
            .SpecialCells(xlCellTypeVisible).Copy ws.Cells(2, 1)
            ws.Columns.AutoFit
            ws.Name = Format(dateCellsDict.Item(j).Value, "mmddyyyy")
        End With
    End If
Next
ResetFilter oWs
Application.ScreenUpdating = True
End Sub