Filter multiple worksheets based on list

alkaline55

New Member
Joined
Jan 24, 2020
Messages
28
Office Version
2016
Platform
Windows
Hi everyone, I'm new to VBA and looking for some guidance. I'd like to filter Column A on three different tabs based on the first value of a list on a separate Name tab. So, find value from A2 on Name tab and filter Column A for it on the 3 tabs.

This is part of a wider macro I'm building.

The wider goal of my macro is to complete step 1 above, save down a copy of the workbook titled Name.xlsx, and loop to the next name in the list. Help with the broader goal or the first step is greatly appreciated.

Thank you so much
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,600
Do you have headers in row 1 with your data starting in row 2 on each sheet?
Do you have any blank rows in the 3 sheets?
Do you want to save each name workbook to the same folder as the workbook containing the macro?
 

alkaline55

New Member
Joined
Jan 24, 2020
Messages
28
Office Version
2016
Platform
Windows
Hi, I do have headers with data starting at row2. No blank rows of the 3 sheets. And yes I'd like them saved in the same folder :)
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,600
Try:
VBA Code:
Sub FilterSheets()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, srcWB As Workbook, desWB As Workbook, srcWS As Worksheet, rName As Range
    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Sheets("Name")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rName In srcWS.Range("A2:A" & LastRow)
        Set desWB = Application.Workbooks.Add(1)
        With srcWB
            For Each ws In .Sheets
                If ws.Name <> "Name" Then
                    With ws.Cells(1).CurrentRegion
                        .AutoFilter 1, rName
                    End With
                    With ws
                        .Copy after:=desWB.Sheets(desWB.Sheets.Count)
                        .Range("A1").AutoFilter
                    End With
                End If
            Next ws
            Application.DisplayAlerts = False
            Sheets("Sheet1").Delete
            Application.DisplayAlerts = True
            With desWB
                .SaveAs srcWB.Path & Application.PathSeparator & rName & ".xlsx"
                .Close False
            End With
        End With
    Next rName
    Application.ScreenUpdating = True
End Sub
This macro assumes that you have only 4 sheets in your workbook and that the first sheet is named "Name".
 

alkaline55

New Member
Joined
Jan 24, 2020
Messages
28
Office Version
2016
Platform
Windows
Thank you so much this works! One other question, is there a way to filter and clear all other rows that don't match the criteria?
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,600
Try:
VBA Code:
Sub FilterSheets()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet, srcWB As Workbook, desWB As Workbook, srcWS As Worksheet, rName As Range
    Set srcWB = ThisWorkbook
    Set srcWS = srcWB.Sheets("Name")
    LastRow = srcWS.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rName In srcWS.Range("A2:A" & LastRow)
        Set desWB = Application.Workbooks.Add(1)
        With srcWB
            For Each ws In .Sheets
                If ws.Name <> "Name" Then
                    With ws.Cells(1).CurrentRegion
                        .AutoFilter 1, "<>" & rName
                    End With
                    With ws
                        .Copy after:=desWB.Sheets(desWB.Sheets.Count)
                        desWB.Sheets(desWB.Sheets.Count).AutoFilter.Range.Offset(1).EntireRow.Delete
                        desWB.Sheets(desWB.Sheets.Count).Range("A1").AutoFilter
                        .Range("A1").AutoFilter
                    End With
                End If
            Next ws
            Application.DisplayAlerts = False
            Sheets("Sheet1").Delete
            With desWB
                .SaveAs srcWB.Path & Application.PathSeparator & rName & ".xlsx"
                .Close False
            End With
            Application.DisplayAlerts = True
        End With
    Next rName
    Application.ScreenUpdating = True
End Sub
 

alkaline55

New Member
Joined
Jan 24, 2020
Messages
28
Office Version
2016
Platform
Windows
This is awesome! :cool: I have one final question, if I had other tabs that I wanted to keep with the saved down copy of the file say "Sheet1" and "Sheet2" ...How can I modify the code?
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,600
Do you simply want a copy of the other sheets in the saved files without modifying them in any way? If so, what are the names of all the sheets you want to copy?
 

alkaline55

New Member
Joined
Jan 24, 2020
Messages
28
Office Version
2016
Platform
Windows
Yes, exactly. They are called "Summary" and "Detail". I may add some others, but if I see your code I will be able to figure out how to add additional ones.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
8,600
What are the actual names of the 3 sheets that are being filtered? Will these names ever change?
 

Forum statistics

Threads
1,085,149
Messages
5,381,992
Members
401,764
Latest member
pzippel

Some videos you may like

This Week's Hot Topics

Top