nidenikolev
08-29-2018, 11:48 AM
I have this macro that takes a roster, and filters it up by manager's employee scope.
It finds the managers names in column AS and then I made a separate worksheet with that manager and only included (listed) the manager entire rows I wanted from column AS.
The macro works well, but I am curious as how I would Dim/Set a new layer for saving the files. Right now I have it so it has a separate call to macro to save under current date, and then saving by
.SaveAs Filename:="M:\Lvl3-5Mgrs\" & Format(Date, "yyyy_mm_dd") & "\" & Format(Date, "yyyy_mm_dd_") & Manager, FileFormat:=xlOpenXMLWorkbook
but what if I wanted it to create a folder by date and then by the leading manager (name found in column AR)? Then I could have the files divided by market leader instead of a bunch of managers in one folder.
For clarification, I want it to (save filtered roster data to folder by current date), then save filtered into current date folder by market leader of the managers data I extract (leaders names found in column AR), and then save it like I have it in the script. heres the script:
Sub Lvl4Mgr()
Dim Managers, Manager, Leader
Dim Header As Range, Where As Range, This As Range
Dim Wb As Workbook
'Prepare
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Refer to the headings
Set Header = Range("A1").EntireRow
'Refer to all managers in level4
Set Where = Range("AS2", Range("AS" & Rows.Count).End(xlUp))
'Get the managers
With Worksheets("Lvl4")
Set Managers = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
'Loop through
For Each Manager In Managers
'Find them
Set This = FindAll(Where, Manager)
If This Is Nothing Then GoTo Skip
'Create a new file
Set Wb = Workbooks.Add(XlWBATemplate.xlWBATWorksheet)
With Wb
With .Sheets(1)
'Copy the header
Header.Copy .Range("A1")
'Copy the data
This.EntireRow.Copy .Range("A2")
End With
With .Sheets(1)
Cells.EntireColumn.AutoFit
End With
Columns("C:C").NumberFormat = "mm/dd/yyyy"
Columns("BN:BN").NumberFormat = "mm/dd/yyyy"
Rows("1:1").AutoFilter
'Save it
.SaveAs Filename:="M:\Lvl3-5Mgrs\" & Format(Date, "yyyy_mm_dd") _
& "\" & Format(Date, "yyyy_mm_dd_") & Manager, FileFormat:=xlOpenXMLWorkbook, Password:="Ville18$
.Close
End With
Skip:
Next
'Done
End Sub
Heres the call to I use to create folder by date if that helps:
Dim sPath As String
sPath = "M:\Lvl3-5Mgrs\"
If Len(Dir(sPath & Format(Date, "yyyy_mm_dd"), vbDirectory)) = 0 Then
MkDir (sPath & Format(Date, "yyyy_mm_dd"))
End If
End Sub
It finds the managers names in column AS and then I made a separate worksheet with that manager and only included (listed) the manager entire rows I wanted from column AS.
The macro works well, but I am curious as how I would Dim/Set a new layer for saving the files. Right now I have it so it has a separate call to macro to save under current date, and then saving by
.SaveAs Filename:="M:\Lvl3-5Mgrs\" & Format(Date, "yyyy_mm_dd") & "\" & Format(Date, "yyyy_mm_dd_") & Manager, FileFormat:=xlOpenXMLWorkbook
but what if I wanted it to create a folder by date and then by the leading manager (name found in column AR)? Then I could have the files divided by market leader instead of a bunch of managers in one folder.
For clarification, I want it to (save filtered roster data to folder by current date), then save filtered into current date folder by market leader of the managers data I extract (leaders names found in column AR), and then save it like I have it in the script. heres the script:
Sub Lvl4Mgr()
Dim Managers, Manager, Leader
Dim Header As Range, Where As Range, This As Range
Dim Wb As Workbook
'Prepare
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'Refer to the headings
Set Header = Range("A1").EntireRow
'Refer to all managers in level4
Set Where = Range("AS2", Range("AS" & Rows.Count).End(xlUp))
'Get the managers
With Worksheets("Lvl4")
Set Managers = .Range("A2", .Range("A" & Rows.Count).End(xlUp))
End With
'Loop through
For Each Manager In Managers
'Find them
Set This = FindAll(Where, Manager)
If This Is Nothing Then GoTo Skip
'Create a new file
Set Wb = Workbooks.Add(XlWBATemplate.xlWBATWorksheet)
With Wb
With .Sheets(1)
'Copy the header
Header.Copy .Range("A1")
'Copy the data
This.EntireRow.Copy .Range("A2")
End With
With .Sheets(1)
Cells.EntireColumn.AutoFit
End With
Columns("C:C").NumberFormat = "mm/dd/yyyy"
Columns("BN:BN").NumberFormat = "mm/dd/yyyy"
Rows("1:1").AutoFilter
'Save it
.SaveAs Filename:="M:\Lvl3-5Mgrs\" & Format(Date, "yyyy_mm_dd") _
& "\" & Format(Date, "yyyy_mm_dd_") & Manager, FileFormat:=xlOpenXMLWorkbook, Password:="Ville18$
.Close
End With
Skip:
Next
'Done
End Sub
Heres the call to I use to create folder by date if that helps:
Dim sPath As String
sPath = "M:\Lvl3-5Mgrs\"
If Len(Dir(sPath & Format(Date, "yyyy_mm_dd"), vbDirectory)) = 0 Then
MkDir (sPath & Format(Date, "yyyy_mm_dd"))
End If
End Sub