Excel File Split Macro

%3CLINGO-SUB%20id%3D%22lingo-sub-1471579%22%20slang%3D%22en-US%22%3EExcel%20File%20Split%20Macro%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1471579%22%20slang%3D%22en-US%22%3E%3CP%3EAttached%20a%20copy%20of%20a%20Macro-enabled%20file%20I%20use%20to%20split%20out%20a%20master%20document%20into%20multiple%20individual%20workbooks.%26nbsp%3B%20My%20question%20is%20for%20anyone%20familiar%20with%20Macros%2FVBA%20as%20I%20am%20not%20-%20I've%20only%20had%20this%20template%20for%20several%20years%20and%20just%20update%20the%20report%20format%20as%20need%20be%20-%20I%20would%20like%20to%20get%20the%20file%20naming%20portion%20of%20the%20routine%20to%20operate%20correctly.%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3ERight%20now%20the%20macro%20sorts%20and%20filters%20the%20%22Template%22%20tab%20by%20Column%20A%2C%20and%20copies%20all%20rows%20with%20matching%20cell%20A%20data%20to%20a%20new%20book.%26nbsp%3B%20Then%20that%20book%20is%20saved%20with%20a%20name%20that%20matches%20cell%20A%20exactly.%26nbsp%3B%20I've%20screwed%20around%20with%20the%20VBA%20to%20try%20and%20get%20these%20to%20change%20to%20a%20concatenated%20name%20format%20that%20follows%20this%20form%3A%26nbsp%3B%20YYYY-MM-DD-(Text%20of%20Cell%20A).xlsx%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20know%20I%20can%20use%20the%20%22Today()%22%20function%20for%20the%20date%2C%20but%20translating%20this%20entire%20thing%26nbsp%3Binto%20the%20naming%20portion%20of%20the%20VBA%20is%20a%20bit%20above%20me.%26nbsp%3B%20Suggestions%20anyone%3F%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-1471579%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EExcel%3C%2FLINGO-LABEL%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1493978%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20File%20Split%20Macro%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1493978%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F248194%22%20target%3D%22_blank%22%3E%40JoeCavasin%3C%2FA%3E%26nbsp%3BI%20think%20this%20file%20is%20working%20please%20check%20it%20out%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1494093%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20File%20Split%20Macro%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1494093%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F699938%22%20target%3D%22_blank%22%3E%40DevendraJain%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIf%20you%20wish%2C%20you%20may%20directly%20format%20the%20date%20in%20the%20code%20instead%20of%20reading%20the%20formatted%20date%20from%20the%20cell%20if%20it%20is%20always%20today's%20date%20like%20this...%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3Edt%20%3D%20Format(Date%2C%20%22yyyy-mm-dd%20%22)%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1633104%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20File%20Split%20Macro%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1633104%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F394231%22%20target%3D%22_blank%22%3E%40Subodh_Tiwari_sktneer%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThank%20you!%26nbsp%3B%20the%20date%20will%20always%20be%20%22today%22%2C%20works%20perfectly.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3Eonly%20other%20question%20-%20is%20it%20possible%20to%20have%20the%20sheet%20only%20make%20split%20copies%20for%20which%20there%20is%20data%20in%20column%20A%3F%26nbsp%3B%20IE%20-%20the%20control%20sheet%20lists%20the%208%20identifiers%20that%26nbsp%3B%3CEM%3Emay%3C%2FEM%3E%20show%20up%20in%20column%20A%2C%20but%20not%20every%20run%20of%20this%20will%20have%20all%208%20in%20column%20A.%26nbsp%3B%20If%20on%20any%20given%20run%20only%202%20or%203%20of%20the%20identifiers%20are%20present%2C%20is%20it%20possible%20to%20have%20excel%20only%20split%20out%20to%20those%20two%20or%20three%20sheets%2C%20and%20not%20make%20all%20the%20other%20blank%20sheets%3F%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThanks%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-1634785%22%20slang%3D%22en-US%22%3ERe%3A%20Excel%20File%20Split%20Macro%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-1634785%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F248194%22%20target%3D%22_blank%22%3E%40JoeCavasin%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EI%20have%20written%20the%20entire%20code%20from%20scratch.%20Please%20test%20it%20and%20let%20me%20know%20if%20that%20works%20fine%20on%20your%20end.%3C%2FP%3E%3CPRE%20class%3D%22lia-code-sample%20language-applescript%22%3E%3CCODE%3ESub%20Breakout()%0A%20%20%20%20Dim%20wsTemplate%20%20%20%20%20%20As%20Worksheet%0A%20%20%20%20Dim%20wsControl%20%20%20%20%20%20%20As%20Worksheet%0A%20%20%20%20Dim%20wbReport%20%20%20%20%20%20%20%20As%20Workbook%0A%20%20%20%20Dim%20Rng%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Range%0A%20%20%20%20Dim%20Cel%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Range%0A%20%20%20%20Dim%20lr%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Long%0A%20%20%20%20Dim%20tlr%20%20%20%20%20%20%20%20%20%20%20%20%20As%20Long%0A%20%20%20%20Dim%20strFileName%20%20%20%20%20As%20String%0A%20%20%20%20Dim%20strFilePath%20%20%20%20%20As%20String%0A%20%20%20%20Dim%20dt%20%20%20%20%20%20%20%20%20%20%20%20%20%20As%20String%0A%20%20%20%20%0A%20%20%20%20Application.DisplayAlerts%20%3D%20False%0A%20%20%20%20Application.ScreenUpdating%20%3D%20False%0A%20%20%20%20%0A%20%20%20%20Set%20wsTemplate%20%3D%20ThisWorkbook.Worksheets(%22Template%22)%0A%20%20%20%20Set%20wsControl%20%3D%20ThisWorkbook.Worksheets(%22Control%22)%0A%20%20%20%20%20%20%20%20%0A%20%20%20%20If%20wsControl.Range(%22E1%22).Value%20%3D%20%22%22%20Then%0A%20%20%20%20%20%20%20%20MsgBox%20%22Please%20input%20the%20path%20for%20the%20destination%20file%20in%20E1%20on%20Control%20Sheet%20first%20and%20then%20try%20again...%22%2C%20vbExclamation%0A%20%20%20%20%20%20%20%20Exit%20Sub%0A%20%20%20%20End%20If%0A%20%20%20%20%0A%20%20%20%20strFilePath%20%3D%20wsControl.Range(%22E1%22).Value%0A%20%20%20%20%0A%20%20%20%20If%20Right(strFilePath%2C%201)%20%26lt%3B%26gt%3B%20%22%5C%22%20Then%20strFilePath%20%3D%20strFilePath%20%26amp%3B%20Application.PathSeparator%0A%20%20%20%20%0A%20%20%20%20If%20Dir(strFilePath%2C%20vbDirectory)%20%3D%20%22%22%20Then%0A%20%20%20%20%20%20%20%20MsgBox%20%22The%20folder%20%22%20%26amp%3B%20strFilePath%20%26amp%3B%20%22%20doesn't%20exist.%22%2C%20vbExclamation%0A%20%20%20%20%20%20%20%20Exit%20Sub%0A%20%20%20%20End%20If%0A%20%20%20%20dt%20%3D%20Sheets(%22Control%22).Range(%22E2%22).Value%0A%20%20%20%20%0A%20%20%20%20wsTemplate.AutoFilterMode%20%3D%20False%0A%20%20%20%20tlr%20%3D%20wsTemplate.Cells(Rows.Count%2C%201).End(xlUp).Row%0A%20%20%20%20wsTemplate.Sort.SortFields.Clear%0A%20%20%20%20wsTemplate.Range(%22A1%22).Sort%20key1%3A%3DwsTemplate.Range(%22A2%22)%2C%20order1%3A%3DxlAscending%2C%20Header%3A%3DxlYes%0A%20%20%20%20%0A%20%20%20%20lr%20%3D%20wsControl.Cells(Rows.Count%2C%201).End(xlUp).Row%0A%20%20%20%20Set%20Rng%20%3D%20wsControl.Range(%22A2%3AA%22%20%26amp%3B%20lr)%0A%20%20%20%20%0A%20%20%20%20For%20Each%20Cel%20In%20Rng%0A%20%20%20%20%20%20%20%20If%20Cel.Value%20%26lt%3B%26gt%3B%20%22%22%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20wsTemplate.Rows(1).AutoFilter%20field%3A%3D1%2C%20Criteria1%3A%3DCel.Value%0A%20%20%20%20%20%20%20%20%20%20%20%20If%20wsTemplate.Range(%22A1%3AA%22%20%26amp%3B%20tlr).SpecialCells(xlCellTypeVisible).Cells.Count%20%26gt%3B%201%20Then%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20strFileName%20%3D%20dt%20%26amp%3B%20Cel.Value%20%26amp%3B%20%22.xls%22%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20strFileName%20%3D%20strFilePath%20%26amp%3B%20strFileName%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20wsTemplate.Copy%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20Set%20wbReport%20%3D%20ActiveWorkbook%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20wbReport.SaveAs%20Filename%3A%3DstrFileName%2C%20FileFormat%3A%3DxlNormal%2C%20Password%3A%3D%22%22%2C%20WriteResPassword%3A%3D%22%22%2C%20ReadOnlyRecommended%3A%3DFalse%2C%20CreateBackup%3A%3DFalse%0A%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20%20wbReport.Close%20True%0A%20%20%20%20%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20%20%20%20%20End%20If%0A%20%20%20%20Next%20Cel%0A%20%20%20%20If%20wsTemplate.FilterMode%20Then%20wsTemplate.ShowAllData%0A%20%20%20%20Application.DisplayAlerts%20%3D%20False%0A%20%20%20%20Application.ScreenUpdating%20%3D%20True%0A%20%20%20%20MsgBox%20%22Task%20completed!%22%2C%20vbInformation%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EIn%20the%20attached%2C%20click%20the%20button%20called%20%22Create%20Reports%22%20on%20Control%20Sheet%20to%20run%20the%20code.%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E
Highlighted
Occasional Contributor

Attached a copy of a Macro-enabled file I use to split out a master document into multiple individual workbooks.  My question is for anyone familiar with Macros/VBA as I am not - I've only had this template for several years and just update the report format as need be - I would like to get the file naming portion of the routine to operate correctly. 

 

Right now the macro sorts and filters the "Template" tab by Column A, and copies all rows with matching cell A data to a new book.  Then that book is saved with a name that matches cell A exactly.  I've screwed around with the VBA to try and get these to change to a concatenated name format that follows this form:  YYYY-MM-DD-(Text of Cell A).xlsx

 

I know I can use the "Today()" function for the date, but translating this entire thing into the naming portion of the VBA is a bit above me.  Suggestions anyone?

4 Replies
Highlighted

@JoeCavasin I think this file is working please check it out

Highlighted

@DevendraJain 

If you wish, you may directly format the date in the code instead of reading the formatted date from the cell if it is always today's date like this...

 

dt = Format(Date, "yyyy-mm-dd ")
Highlighted

@Subodh_Tiwari_sktneer 

 

Thank you!  the date will always be "today", works perfectly.

 

only other question - is it possible to have the sheet only make split copies for which there is data in column A?  IE - the control sheet lists the 8 identifiers that may show up in column A, but not every run of this will have all 8 in column A.  If on any given run only 2 or 3 of the identifiers are present, is it possible to have excel only split out to those two or three sheets, and not make all the other blank sheets?

 

Thanks

Highlighted

@JoeCavasin 

 

I have written the entire code from scratch. Please test it and let me know if that works fine on your end.

Sub Breakout()
    Dim wsTemplate      As Worksheet
    Dim wsControl       As Worksheet
    Dim wbReport        As Workbook
    Dim Rng             As Range
    Dim Cel             As Range
    Dim lr              As Long
    Dim tlr             As Long
    Dim strFileName     As String
    Dim strFilePath     As String
    Dim dt              As String
    
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    Set wsTemplate = ThisWorkbook.Worksheets("Template")
    Set wsControl = ThisWorkbook.Worksheets("Control")
        
    If wsControl.Range("E1").Value = "" Then
        MsgBox "Please input the path for the destination file in E1 on Control Sheet first and then try again...", vbExclamation
        Exit Sub
    End If
    
    strFilePath = wsControl.Range("E1").Value
    
    If Right(strFilePath, 1) <> "\" Then strFilePath = strFilePath & Application.PathSeparator
    
    If Dir(strFilePath, vbDirectory) = "" Then
        MsgBox "The folder " & strFilePath & " doesn't exist.", vbExclamation
        Exit Sub
    End If
    dt = Sheets("Control").Range("E2").Value
    
    wsTemplate.AutoFilterMode = False
    tlr = wsTemplate.Cells(Rows.Count, 1).End(xlUp).Row
    wsTemplate.Sort.SortFields.Clear
    wsTemplate.Range("A1").Sort key1:=wsTemplate.Range("A2"), order1:=xlAscending, Header:=xlYes
    
    lr = wsControl.Cells(Rows.Count, 1).End(xlUp).Row
    Set Rng = wsControl.Range("A2:A" & lr)
    
    For Each Cel In Rng
        If Cel.Value <> "" Then
            wsTemplate.Rows(1).AutoFilter field:=1, Criteria1:=Cel.Value
            If wsTemplate.Range("A1:A" & tlr).SpecialCells(xlCellTypeVisible).Cells.Count > 1 Then
                strFileName = dt & Cel.Value & ".xls"
                strFileName = strFilePath & strFileName
                wsTemplate.Copy
                Set wbReport = ActiveWorkbook
                wbReport.SaveAs Filename:=strFileName, FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False
                wbReport.Close True
            End If
        End If
    Next Cel
    If wsTemplate.FilterMode Then wsTemplate.ShowAllData
    Application.DisplayAlerts = False
    Application.ScreenUpdating = True
    MsgBox "Task completed!", vbInformation
End Sub

 

In the attached, click the button called "Create Reports" on Control Sheet to run the code.