VBA to filter and export sheets based on data validation list

[gmittar]

Hi all,

I have a file for a number of different orgs, and I'm trying to get to a solution where I run a macro, and it filters the sheet, copies values to a new sheet and saves it to a designated location. I'm hoping to get one run of the macro to accomplish this for all the orgs represented in the file (based on a data validation list).

As illustration, I'm linking to a sample file that I've put together with generic data. It has 10 orgs with just a little bit of data for each. I'm hoping for a solution that gives me 10 files each filtered and named for one of the files on the user list from the original.

Any ideas or starting points? I'm pretty new to this.

https://sagehospitalityllc.box.com/s/ak7qe1p4msqkkpv9mfb5utzqr5ri8iue

 

[John_w]

Try this macro:

Public Sub Create_Org_Workbooks()

    Dim destFolder As String
    Dim filteredCells As Range
    Dim orgWorkbook As Workbook
    Dim dataValidationCell As Range, dataValidationListSource As Range, dataValidationListCell As Range
    
    'destFolder = "C:\folder\path\"              'specific folder
    destFolder = ThisWorkbook.Path & "\"        'or same folder as this macro workbook
    If Right(destFolder, 1) <> "\" Then destFolder = destFolder & "\"
    
    Application.ScreenUpdating = False
    
    With Sheet1
    
        'Cell A1 contains the Data validation
        
        Set dataValidationCell = .Range("A1")
     
        'Determine Data validation list source range
        
        Set dataValidationListSource = Evaluate(dataValidationCell.Validation.Formula1)
     
        'Loop through Data validation list cells
     
        For Each dataValidationListCell In dataValidationListSource
        
            'Change data validation cell value - this triggers the Sheet1 Worksheet_Change event which applies the filter
            'according to the current data validation cell value
            
            dataValidationCell.Value = dataValidationListCell.Value
               
            Set filteredCells = .AutoFilter.Range.SpecialCells(xlCellTypeVisible).EntireRow
            
            'Copy visible rows to a new workbook and save as the org name in the specified folder
            
            Set orgWorkbook = Workbooks.Add(xlWBATWorksheet)
            filteredCells.Copy orgWorkbook.Worksheets(1).Range("A1")
            Application.DisplayAlerts = False
            orgWorkbook.SaveAs destFolder & dataValidationCell.Value & ".xlsx", xlOpenXMLWorkbook
            Application.DisplayAlerts = True
            orgWorkbook.Close False
        
        Next

        'Remove autofilter
        
        .AutoFilterMode = False
        
    End With
        
    Application.ScreenUpdating = True
    
    MsgBox "Done"

End Sub

The 10 Org workbooks are created in the same folder as the macro workbook, and there is also a commented out line showing how to specify a specific folder.

Note that the above code triggers the Worksheet_Change event in Sheet1 to apply the autofilter. Since you only want a change to A1 to apply the autofilter, this code should really be:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A1")) Is Nothing Then
        filter_Org
    End If
End Sub

Another thing I noticed is that your modules don't have Option Explicit at the top. With this, all variables must be declared, and this is essential to guard against programming errors. To have Option Explicit added automatically at the top of any new modules or new workbooks, in the VBA editor click Tools - Options - Editor tab - and tick Require Variable Declaration.

 

[gmittar]

Thank you John, that works quite well.

And I appreciate the feedback on the Option Explicit. I know I need to get better at that, it's mainly a skill level thing (in that mine is very low). I've changed the setting that you recommend.