VBA to Save Worksheet With Current Date (Opening New Folder For Month / Year)

Small Paul

Board Regular
Joined
Jun 28, 2018
Messages
118
Hi All
I have a number of worksheets produced each day which need saving.
The worksheet name is formatted as "yyyy mm dd"

I need it saved in the relevant month's folder and, if not available, set that folder up. The month folder is set as, for example, "08 August" and "09 September". This way, they sit in order within the year folder.

Ideally, the VBA would also set up a year folder when required.

Looking through other posts, the best I can find is:
Code:
    Dim fPath As String    MkDir "Z:\Orders\2-Open Trades" & Format(Date, "yyyy") & "" & Format(Date, "mm-yy")
    fPath = "Z:\Orders\2-Open Trades" & Format(Date, "yyyy") & "" & Format(Date, "mm-yy")

which doesn't actually save the file at all!

The directory for the main file is:

Z:\Orders\2-Open Trades\yyyy\[08 August] see above\filename.xls

I can then adjust (primary folders) accordingly.

Any assistance would be appreciated.

Many thanks
Small Paul.
 

Excel Facts

Quick Sum
Select a range of cells. The total appears in bottom right of Excel screen. Right-click total to add Max, Min, Count, Average.
this can be used to check for folder, if not there then create it and save file to correct folder

Code:
Sub TestForDir()
Dim strDir As String


    strDir = Range("A1")
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
    
    End If
    
    ChDir strDir
    Filename = Format(Now, "yyyy-mm-dd")
    ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=51
End Sub

as above, cell A1 contains directory and foldername
example: c:\temp\08 August

you can manipulate A1 with formulas to get current month like:
Code:
=CONCATENATE(TEXT(MONTH(TODAY()),"MM")," ",TEXT(TODAY(),"MMMM"))
 
Last edited:
Upvote 0
i would end up doing like this for easy customizing:

f2849e2955.png


B1 = user input
B2 =
Code:
=CONCATENATE(YEAR(TODAY()),"\",TEXT(MONTH(TODAY()),"MM")," ",TEXT(TODAY(),"MMMM"),"\")
B3 =
Code:
=CONCATENATE(B1,B2)

vba becomes
Code:
Sub TestForDir()Dim strDir As String, DflDir As String


    DflDir = Range("B1")
    strDir = Range("B3")
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir DflDir
    Else
    
    End If
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
    
    End If
    
    ChDir strDir
    Filename = Format(Now, "yyyy-mm-dd")
    ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=51
End Sub

hope this helps
 
Last edited:
Upvote 0
fully working with year also:

bc1c46eaba.png


B1: user input
B2: =CONCATENATE(B1,YEAR(TODAY()),"")
B3: =CONCATENATE(TEXT(MONTH(TODAY()),"MM")," ",TEXT(TODAY(),"MMMM"),"")
B4: =CONCATENATE(B2,B3)

vba
Code:
Sub TestForDir()
Dim strDir As String, DflDir As String, YrDir as String




    DflDir = Range("B1")
    YrDir = Range("B2")
    strDir = Range("B4")
    
    If Dir(DflDir, vbDirectory) = "" Then
        MkDir DflDir
    Else
    
    End If
    
    If Dir(YrDir, vbDirectory) = "" Then
        MkDir YrDir
    Else
    
    End If
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
    
    End If
    
    ChDir strDir
    Filename = Format(Now, "yyyy-mm-dd")
    ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=51
End Sub

maybe an easier way but this works
 
Last edited:
Upvote 0
I was hoping for a simple "add-on" to my existing macro:
Code:
    Dim lr As Long    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Sheet1").Delete
    Sheets.Add.Name = "Pivot"
    Range("B2").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Table1", Version:=xlPivotTableVersion15).CreatePivotTable TableDestination _
        :="Pivot!R2C2", TableName:="PivotTable10", DefaultVersion:= _
        xlPivotTableVersion15
    Sheets("Pivot").Select
    Cells(2, 2).Select
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Strike Date")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Investment Products Name")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Additional Info")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable10").AddDataField ActiveSheet.PivotTables( _
        "PivotTable10").PivotFields("Investment Product: Total Hedged"), _
        "Sum of Investment Product: Total Hedged", xlSum
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Sum of Investment Product: Total Hedged")
        .Caption = "Average of Investment Product: Total Hedged"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("PivotTable10").AddDataField ActiveSheet.PivotTables( _
        "PivotTable10").PivotFields("Nominal"), "Sum of Nominal", xlSum
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Investment Product: ISIN") _
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Investment Products Name").Subtotals = Array(False, False, _
        False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Additional Info").Subtotals = Array(False, False, False, _
        False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Strike Date").Subtotals = Array(False, False, False, False, _
        False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Investment Currency"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Total Hedged").Subtotals = Array(False, False, False, False, _
        False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Nominal").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Issue Price (%)"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("IPS Date").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Order Received"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Bank Order").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    With ActiveSheet.PivotTables("PivotTable10")
        .ColumnGrand = False
        .RowGrand = False
    End With
    With ActiveSheet.PivotTables("PivotTable10")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    Columns("B:B").ColumnWidth = 19.29
    Columns("C:C").ColumnWidth = 75.86
    Columns("C:C").ColumnWidth = 80.71
    Columns("D:D").ColumnWidth = 19.14
    Columns("E:E").ColumnWidth = 18.29
    Rows("3:3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("E:F").Select
    Selection.Style = "Comma"
    Selection.NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""??_-;_-@_-"
    Selection.NumberFormat = "_-* #,#[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_]#0_[/URL] -;-* #,#[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_]#0_[/URL] -;_-* ""-""??_-;_-@_-"
    Range("E33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-29]C:R[-1]C)"
    Range("F33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-29]C:R[-1]C)"
    Range("D33").Select
    ActiveCell.FormulaR1C1 = "Totals"
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlCenter
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "Shortfall (+ve)  /  Top Up Required (-ve)"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .ColumnWidth = 13.71
        .Font.Bold = True
    End With
    Range("H4:H33").Select
    Selection.NumberFormat = "_-* #,#[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_]#0_[/URL] -;-* #,#[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_]#0_[/URL] -;_-* ""-""??_-;_-@_-"
    With Sheets("Pivot")
    lr = .Range("E" & .Rows.Count).End(xlUp).Row
    If lr > 3 Then .Range("H4:H" & lr).FormulaR1C1 = "=IF(RC[-3]>0,RC[-3]-RC[-2],"""")"
    End With
    Range("A1").Select
    Sheets("Paul All Current Orders").Select
    Columns("A:A").ColumnWidth = 17
    Columns("B:B").ColumnWidth = 77
    Columns("C:C").ColumnWidth = 23
    Columns("D:K").ColumnWidth = 14
    Rows("1:1").Select
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    Columns("F:G").Select
    Selection.Style = "Comma"
    Selection.NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""??_-;_-@_-"
    Selection.NumberFormat = "_-* #,#[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_]#0_[/URL] -;-* #,#[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=0_]#0_[/URL] -;_-* ""-""??_-;_-@_-"
    End With
    With Range("A:A")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
    With Range("A2:A500")
        .HorizontalAlignment = xlCenter
    End With
    With Range("D2:E500")
        .HorizontalAlignment = xlCenter
    End With
    With Range("H2:K500")
        .HorizontalAlignment = xlCenter
    End With
    Range("A1").Select
    Dim fPath As String
    MkDir "Z:\Orders\2-Open Trades" & Format(Date, "yyyy") & "" & Format(Date, "mm-yy")
    fPath = "Z:\Orders\2-Open Trades" & Format(Date, "yyyy") & "" & Format(Date, "mm-yy")
End Sub
Is there not one?
Ta
Small Paul.
 
Upvote 0
try this

Rich (BB code):
 Sub ExistingMacro()
    Dim lr As Long
    Dim strDir As String, DflDir As String, YrDir As String
    
    DflDir = "Z:\Orders\2-Open Trades\"
    YrDir = (DflDir & Format(Date, "yyyy"))
    strDir = (YrDir & "\" & Format(Date, "mm") & " " & Format(Date, "mmmm"))
    
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    Sheets("Sheet1").Delete
    Sheets.Add.Name = "Pivot"
    Range("B2").Select
    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
        "Table1", Version:=xlPivotTableVersion15).CreatePivotTable TableDestination _
        :="Pivot!R2C2", TableName:="PivotTable10", DefaultVersion:= _
        xlPivotTableVersion15
    Sheets("Pivot").Select
    Cells(2, 2).Select
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Strike Date")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Investment Products Name")
        .Orientation = xlRowField
        .Position = 2
    End With
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Additional Info")
        .Orientation = xlRowField
        .Position = 3
    End With
    ActiveSheet.PivotTables("PivotTable10").AddDataField ActiveSheet.PivotTables( _
        "PivotTable10").PivotFields("Investment Product: Total Hedged"), _
        "Sum of Investment Product: Total Hedged", xlSum
    With ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Sum of Investment Product: Total Hedged")
        .Caption = "Average of Investment Product: Total Hedged"
        .Function = xlAverage
    End With
    ActiveSheet.PivotTables("PivotTable10").AddDataField ActiveSheet.PivotTables( _
        "PivotTable10").PivotFields("Nominal"), "Sum of Nominal", xlSum
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Investment Product: ISIN") _
        .Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Investment Products Name").Subtotals = Array(False, False, _
        False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Additional Info").Subtotals = Array(False, False, False, _
        False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Strike Date").Subtotals = Array(False, False, False, False, _
        False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Investment Currency"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields( _
        "Investment Product: Total Hedged").Subtotals = Array(False, False, False, False, _
        False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Nominal").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Issue Price (%)"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("IPS Date").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Order Received"). _
        Subtotals = Array(False, False, False, False, False, False, False, False, False, False, _
        False, False)
    ActiveSheet.PivotTables("PivotTable10").PivotFields("Bank Order").Subtotals = _
        Array(False, False, False, False, False, False, False, False, False, False, False, False)
    With ActiveSheet.PivotTables("PivotTable10")
        .ColumnGrand = False
        .RowGrand = False
    End With
    With ActiveSheet.PivotTables("PivotTable10")
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
    End With
    Columns("B:B").ColumnWidth = 19.29
    Columns("C:C").ColumnWidth = 75.86
    Columns("C:C").ColumnWidth = 80.71
    Columns("D:D").ColumnWidth = 19.14
    Columns("E:E").ColumnWidth = 18.29
    Rows("3:3").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Columns("E:F").Select
    Selection.Style = "Comma"
    Selection.NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""??_-;_-@_-"
    Selection.NumberFormat = "_-* #,##0_  -;-* #,##0_  -;_-* ""-""??_-;_-@_-"
    Range("E33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-29]C:R[-1]C)"
    Range("F33").Select
    ActiveCell.FormulaR1C1 = "=SUM(R[-29]C:R[-1]C)"
    Range("D33").Select
    ActiveCell.FormulaR1C1 = "Totals"
    Selection.Font.Bold = True
    Selection.HorizontalAlignment = xlCenter
    Range("H3").Select
    ActiveCell.FormulaR1C1 = "Shortfall (+ve)  /  Top Up Required (-ve)"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        .ColumnWidth = 13.71
        .Font.Bold = True
    End With
    Range("H4:H33").Select
    Selection.NumberFormat = "_-* #,##0_  -;-* #,##0_  -;_-* ""-""??_-;_-@_-"
    With Sheets("Pivot")
    lr = .Range("E" & .Rows.Count).End(xlUp).Row
    If lr > 3 Then .Range("H4:H" & lr).FormulaR1C1 = "=IF(RC[-3]>0,RC[-3]-RC[-2],"""")"
    End With
    Range("A1").Select
    Sheets("Paul All Current Orders").Select
    Columns("A:A").ColumnWidth = 17
    Columns("B:B").ColumnWidth = 77
    Columns("C:C").ColumnWidth = 23
    Columns("D:K").ColumnWidth = 14
    Rows("1:1").Select
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    Columns("F:G").Select
    Selection.Style = "Comma"
    Selection.NumberFormat = "_-* #,##0.0_-;-* #,##0.0_-;_-* ""-""??_-;_-@_-"
    Selection.NumberFormat = "_-* #,##0_  -;-* #,##0_  -;_-* ""-""??_-;_-@_-"
    End With
    With Range("A:A")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
    End With
    With Range("A2:A500")
        .HorizontalAlignment = xlCenter
    End With
    With Range("D2:E500")
        .HorizontalAlignment = xlCenter
    End With
    With Range("H2:K500")
        .HorizontalAlignment = xlCenter
    End With




 If Dir(DflDir, vbDirectory) = "" Then
        MkDir DflDir
    Else
    
    End If
    
    If Dir(YrDir, vbDirectory) = "" Then
        MkDir YrDir
    Else
    
    End If
    
    If Dir(strDir, vbDirectory) = "" Then
        MkDir strDir
    Else
    
    End If
    
    ChDir strDir
    Filename = Format(Now, "yyyy-mm-dd")
    ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=52
    
End Sub
 
Last edited:
Upvote 0
the vba alone, run it and you will see it works

Code:
Sub dfd()    
Dim strDir As String, DflDir As String, YrDir As String
    
    DflDir = "Z:\Orders\2-Open Trades\"
    YrDir = (DflDir & Format(Date, "yyyy"))
    strDir = (YrDir & "\" & Format(Date, "mm") & " " & Format(Date, "mmmm"))
    
    If Dir(DflDir, vbDirectory) = "" Then MkDir DflDir
    If Dir(YrDir, vbDirectory) = "" Then MkDir YrDir
    If Dir(strDir, vbDirectory) = "" Then MkDir strDir


    ChDir strDir
    
    Filename = Format(Now, "yyyy-mm-dd")
    ActiveWorkbook.SaveAs Filename:=Filename, FileFormat:=52
End Sub

and if you just need to save a copy and keep current workbook active change bottom line to
Code:
ActiveWorkbook.SaveCopyAs Filename:=Filename & ".xlsm"
 
Last edited:
Upvote 0
Hi JumboCactuar
the following is the final few rows of my macro followed by what you have advised:

Code:
    With Range("H2:K500")        .HorizontalAlignment = xlCenter
    End With
    Range("A1").Select
    
Dim strDir As String, DflDir As String, YrDir As String
    DflDir = "Z:\Orders\2-Open Trades\"
    YrDir = (DflDir & Format(Date, "yyyy"))
    strDir = (YrDir & "\" & Format(Date, "mm") & " " & Format(Date, "mmmm"))
    If Dir(DflDir, vbDirectory) = "" Then MkDir DflDir
    If Dir(YrDir, vbDirectory) = "" Then MkDir YrDir
    If Dir(strDir, vbDirectory) = "" Then MkDir strDir
    ChDir strDir
    Filename = Format(Now, "yyyy-mm-dd")
    ActiveWorkbook.SaveCopyAs Filename:=Filename & ".xlsm"
End Sub

Unfortunately, the file does not save.
Regards
Small paul.
 
Upvote 0
Does
Z:\Orders\2-Open Trades\

Already exist? What happens when you run it
 
Upvote 0
Yes, Z:\Orders\2-Open Trades already exists.
I am looking to save this file in the year\month\[today's date] within there.

The macro runs and completes all the required stages until the end. The file simply remains as "Book [x]" (I start with a blank file and download from Salesforce prior to the macro)
 
Upvote 0

Forum statistics

Threads
1,224,824
Messages
6,181,186
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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