Using VBA to dynamically use filters

gers1978 · Oct 8th 2015

I have the attached spreadsheet and I've created some code to create a PivotTable, then format some names, then copy the data to a new sheet.

What I'd like to do is instead of copying all of the data to a single new sheet is create a new sheet per company name, and copy just that companies data to that sheet.

I can obviously record a macro of me doing this for each company by using the filter in the PivotTable, but the resulting code from the macro is not dynamic, i.e. each time I do this the company name is "hard coded" into the code. This is not use if, next month for example, the data changed and there are more/less/different companies to work with.

Is there any way of making this "dynamic"? So that each month, regardless of the data set, I can just click a button to execute the "RunAll" macro and it does what I'm looking for?

Many thanks!

forum.ozgrid.com/index.php?attachment/67154/forum.ozgrid.com/index.php?attachment/67154/

**royUK** · Oct 9th 2015

Re: Using VBA to dynamically use filters

This code will create a sheet for each company. If the sheet exists it will use the existing sheet

Code

Option Explicit


'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 24/09/2006 22:48
' Updated   : 2014
' Author    : Roy Cox (royUK)
' Website   :  more examples
' Purpose   :  Create a sheet for each unique name in data
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.
'---------------------------------------------------------------------------------------


Sub ExtractToSheets()
    Dim ws     As Worksheet
    Dim wsNew  As Worksheet
    Dim rData  As Range
    Dim rCl    As Range
    Dim sNm    As String
    
    Set ws = Sheet1


    'extract a list of unique names
    'first clear existing list
    With ws
        Set rData = .Range("A1").CurrentRegion
        .Columns(.Columns.Count).Clear
        rData.Columns(9).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True


        For Each rCl In .Cells(1, .Columns.Count).CurrentRegion
            sNm = rCl.Text
            'add new sheet (only if required-NB uses UDF)
            If WksExists(sNm) Then
                'so clear contents
                Sheets(sNm).Cells.Clear
            Else
                'new sheet required
                Set wsNew = Sheets.Add
                wsNew.Move After:=Worksheets(Worksheets.Count)    'move to end
                wsNew.Name = sNm
            End If
            'AutoFilter & copy to relevant sheet
            rData.AutoFilter Field:=9, Criteria1:=sNm
            rData.Copy Destination:=Worksheets(sNm).Cells(1, 1)
            Worksheets(sNm).Columns.AutoFit
        Next rCl
    End With
    ws.Columns(Columns.Count).ClearContents        'remove temporary list
    rData.AutoFilter        'switch off AutoFilter
End Sub
Function WksExists(wksName As String) As Boolean
    On Error Resume Next
    WksExists = CBool(Len(Worksheets(wksName).Name) > 0)
End Function

Display More

gers1978 · Oct 9th 2015

Re: Using VBA to dynamically use filters

That's great, thanks.

All I need to do now is figure out how to loop through each of the sheets your code creates and apply the code I came up with to produce the PivotTables.

Using VBA to dynamically use filters

Participate now!

Share