VBA AutoFilter all column A & save as new workbook.

[lewysedmunds]

Hi all,

First time poster - long time reader ?

I have a workbook that for every "Site Code" in Column A, filter & copy all data down and right then save as new worksheet with Site Code and todays date in the title.

Currently the code I have (scavanged from forums) is below:

Sub Filter_SiteCode()
Dim sh1 As Worksheet, SiteCode As Range, wb As Workbook
Set sh1 = Sheets("Sheet1")
    For Each SiteCode In sh1.Range("A1", sh1.Cells(Rows.Count, 2).End(xlUp))
        sh1.UsedRange.AutoFilter 24, SiteCode.Value
            If sh1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
                Set wb = Workbooks.Add
                sh1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
                wb.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
                wb.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
                wb.SaveAs "S:\Audits\1. AM Reviews\XXXX\Daily XXX Quality Review" & "\" & SiteCode.Value & "".xlsx"
                wb.Close False
                sh1.AutoFilterMode = False
            End If
    Next
End Sub

I keep facing the error: AutoFilter method of Range class failed.

I have googled, but as of yet I have no idea what it could be!

 

[Alex Blakenburg]

Your ranges don't seem to make sense.
Do you have a Table of just the Site Code ?
If so please provide an XL2BB of the table. If you can't I need to know the sheet name it is on, and the range of the list (inclusive of the heading) and if you are using a table the name of the table.
Also the same as the above for the data range you are trying to apply the filter to,

 

[lewysedmunds]

Your ranges don't seem to make sense.
Do you have a Table of just the Site Code ?
If so please provide an XL2BB of the table. If you can't I need to know the sheet name it is on, and the range of the list (inclusive of the heading) and if you are using a table the name of the table.
Also the same as the above for the data range you are trying to apply the filter to,

Hi Alex,

Thanks for getting back to me!

The Table itself has a lot of data inside, column A is just Site Codes though - The rest of the table is dates, area managers, things like that.

Sadly I can't share the XL2BB of the table due to the nature of the content - but the sheet name is and will always be: Sheet1

The Range is: A:Q and rows are variable as the report is ran every day with a different amount of outputs.
The data itself isn't within an actual table - it is just lists of data with headings.

The filter + export / save as new workbooks is only for Column A (filter everything from A1 down (A1 is the header))

I hope this makes sense but I feel like it doesn't!

 

[Alex Blakenburg]

It does make sense, my issue with it though just looping through column A then filtering on site code doesn't work.
Presumably site codes repeat in column A so you only want to filter on each site code once.
Also the code is including Column B aka column 2 in the SiteCode range.

For Each SiteCode In sh1.Range("A1", sh1.Cells(Rows.Count, 2).End(xlUp))

Are your site codes static, in which case how about setting up a site code Master Table ?
If not we need to loop through the whole of Column A first to create a list of Site Codes.

 

[Alex Blakenburg]

Give this a try.
Note: Everything indicates that Site Code is in column A and that you want to filter on site code.
Your filter line say column 24. I have changed that to column A / column 1.

Sub Filter_SiteCode()
    Dim sh1 As Worksheet, SiteCode As Range, wb As Workbook
    Dim rng As Range
    Dim arrSiteCode() As Variant
    Dim siteCell As Range
    Dim siteDict As Object
    Dim key As Variant
    Dim i As Long
    
    Set sh1 = Sheets("Sheet1")
    Set siteDict = CreateObject("Scripting.Dictionary")
    Set rng = sh1.Range("A1").CurrentRegion
    arrSiteCode = rng.Columns(1).Value
    
    For i = LBound(arrSiteCode) + 1 To UBound(arrSiteCode)
        If Not siteDict.Exists(arrSiteCode(i, 1)) Then
            siteDict.Add key:=arrSiteCode(i, 1), Item:=""
        End If
    Next i
    
    For Each key In siteDict
        rng.AutoFilter 1, key
        
        If sh1.AutoFilter.Range.Columns(1).Rows.SpecialCells(xlCellTypeVisible).Count > 1 Then
            Set wb = Workbooks.Add
            rng.SpecialCells(xlCellTypeVisible).Copy
            wb.Sheets(1).Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
            wb.Sheets(1).Range("A1").PasteSpecial xlPasteFormats
            wb.SaveAs "S:\Audits\1. AM Reviews\XXXX\Daily XXX Quality Review" & "\" & key & "".xlsx"
            wb.Close False
            sh1.AutoFilterMode = False
        End If
    Next
End Sub