VBA to filter and export sheets based on data validation list

gmittar

Board Regular
Joined
Sep 16, 2013
Messages
62
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
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Try this macro:
Code:
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:
Code:
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.
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,531
Messages
6,114,172
Members
448,554
Latest member
Gleisner2

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top