06-17-2020 10:07 AM
06-17-2020 10:07 AM
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?
09-03-2020 12:46 PM
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?
09-04-2020 01:31 AM
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.