Trying to see if i can add a date from an active sheet to my vba save i use.

zone709

Well-known Member
Joined
Mar 1, 2016
Messages
2,129
Office Version
  1. 365
Platform
  1. Windows
Hi I use below to save my work after I run all my vba, but I need to add something to this if I can. Right now it save file name and time as you can see
SaveName ="LCP Complete File" & Format(Now, "HH.MM.SS") .

but I need to add the date of the ending period that's on active sheet I'm saving. The date it always in E2. Any possible way of adding this to this.

Results now when saved LCP Complete File16.42.40
Trying to get this result -->LCP Complete File16.42.40 - 2/25/2018 <-- this is in E2 always


Code:
[FONT=Calibri][SIZE=3][COLOR=#000000]Sub SaveFileButtonDateLCP40() '---LCP File Save---'[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Dim SaveName As String[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Const MyPath As String = "C:       'This is the path it's using for savesbefore the dates[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]ReName:[/COLOR][/SIZE][/FONT]


[SIZE=3][COLOR=#000000][FONT=Calibri]    SaveName ="LCP Complete File" & Format(Now, "HH.MM.SS")   ‘[/FONT][FONT=Wingdings]ß[/FONT][FONT=Calibri]Add date here[/FONT][/COLOR][/SIZE]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Len(SaveName)> 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        SaveName =SaveName & ".xlsx"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        IfLen(Dir(MyPath & Format(Now, "yy") & "-" &Format$(Now, "mmm"), vbDirectory)) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            MkDirMyPath & Format(Now, "yy") & "-" & Format$(Now,"mmm") & "\"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        IfLen(Dir(MyPath & Format(Now, "yy") & "-" &Format$(Now, "mmm") & "\" & Format(Now,"mm") & "-" & Format(Now, "dd") &"-" & Format(Now, "yyyy"), vbDirectory)) = 0 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]            MkDirMyPath & Format(Now, "yy") & "-" & Format$(Now,"mmm") & "\" & Format(Now, "mm") &"-" & Format(Now, "dd") & "-" &Format(Now, "yyyy") & "\"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]       ActiveWorkbook.SaveAs Filename:=MyPath & Format(Now, "yy")& "-" & Format$(Now, "mmm") & "\"& Format(Now, "mm") & _[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           "-" & Format(Now, "dd") & "-"& Format(Now, "yyyy") & "\" & SaveName,FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]  [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    MsgBox "Savedin Folder"[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]Exit Sub[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] [/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]ErrorHandle:[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    If Err.Number = 75Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        Resume Next[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    ElseIf Err.Number= 1004 Then[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        MsgBox("That name is already used for this day. Please try again!")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]        GoTo ReName[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    Else: MsgBox("There is an unknown error")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]    End If[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]End Sub[/COLOR][/SIZE][/FONT]
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Code:
SaveName = "LCP Complete File " & Format(Now, "HH.MM.SS") & " - " & Sheets("Sheet1").Range("E2").Value
.
 
Last edited:
Upvote 0
Code:
SaveName = "LCP Complete File " & Format(Now, "HH.MM.SS") & " - " & Sheets("Sheet1").Range("E2").Value
.

Hi thanks for reply. Looks like what im looking. Havent tried it yet but ill let you know. thanks
 
Upvote 0
Never mind this works thanks
 
Last edited:
Upvote 0
Actually I am having a problem and cant figure it out. If I have Value E2 I have an issue. If I have Value F2 it works fine. I cant figure out why I am having the problem in E2. as you can see its the date. Can it be this / or the columns is date idk. The F column is number format. Not sure why E is debugging

Excel 2016 (Windows) 32 bit
[Table="width:, class:head"][tr=bgcolor:#888888][th] [/th][th]
E
[/th][th]
F
[/th][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
1
[/td][td]PERIOD END DATE[/td][td]GROSS PAY[/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
2
[/td][td]
2/25/2018​
[/td][td]
2576.25​
[/td][/tr]
[tr=bgcolor:#FFFFFF][td=bgcolor:#888888]
3
[/td][td]
2/25/2018​
[/td][td]
4025.00​
[/td][/tr]
[/table]
[Table="width:, class:grid"][tr][td]Sheet: Paychex[/td][/tr][/table]
 
Upvote 0
What I added and where it breaks.

Code:
[FONT=Calibri][SIZE=3][COLOR=#000000]SaveName = "LCP Complete File " & Format(Now,"HH.MM.SS") & " - " &Sheets("Paychex").Range("E2").Value[/COLOR][/SIZE][/FONT]

Breaks here:

Code:
[FONT=Calibri][SIZE=3][COLOR=#000000]       ActiveWorkbook.SaveAs Filename:=MyPath & Format(Now, "yy")& "-" & Format$(Now, "mmm") & "\"& Format(Now, "mm") & _[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]           "-" & Format(Now, "dd") & "-"& Format(Now, "yyyy") & "\" & SaveName,FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/COLOR][/SIZE][/FONT]
 
Upvote 0
Note I changed the Path I dont like going direct to C: and the way you posted it I was not sure the exact format on that thus why I avoid it haha.

Yes it appears since your date in Cell E2 contains a / it is causing it to error. That is not a valid character for a filename, if you tried to save a file with the name MyFile/Pandas.xlsx this would error, so I switched the / for -

You may also get an error at the SaveAs code highlighted below as you may be saving in an odd format, for example I got a warning about saving a Macro file as .xlsx when I ran this. If you click yes you can just ignore it and save the file. You can also turn that off with Application.DisplayAlerts = False just be sure to turn it back on after you save.

Code:
Sub SaveFileButtonDateLCP40() '---LCP File Save---'
Dim SaveName As String
Const MyPath As String = [COLOR=#ff0000]"C:\Temp\"[/COLOR]
ReName:


    [COLOR=#ff0000]ValFrmSheet = Replace(Sheets("Sheet1").Range("E2").Value, "/", "-")[/COLOR]
    SaveName = "LCP Complete File " & Format(Now, "HH.MM.SS") & " - " & [COLOR=#ff0000]ValFrmSheet[/COLOR]
    If Len(SaveName) > 0 Then
        SaveName = SaveName &[COLOR=#ff0000] ".xlsx"[/COLOR]
        If Len(Dir(MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm"), vbDirectory)) = 0 Then
            MkDir MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\"
        End If
        If Len(Dir(MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\" & Format(Now, "mm") & "-" & Format(Now, "dd") & "-" & Format(Now, "yyyy"), vbDirectory)) = 0 Then
            MkDir MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\" & Format(Now, "mm") & "-" & Format(Now, "dd") & "-" & Format(Now, "yyyy") & "\"
        End If
[COLOR=#ff0000]       ActiveWorkbook.SaveAs Filename:=MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\" & Format(Now, "mm") & _[/COLOR]
[COLOR=#ff0000]           "-" & Format(Now, "dd") & "-" & Format(Now, "yyyy") & "\" & SaveName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/COLOR]


    End If
    MsgBox "Savedin Folder"


Exit Sub


ErrorHandle:
    If Err.Number = 75 Then
        Resume Next
    ElseIf Err.Number = 1004 Then
        MsgBox ("That name is already used for this day. Please try again!")
        GoTo ReName
    Else: MsgBox ("There is an unknown error")
    End If
End Sub
 
Last edited:
Upvote 0
Note I changed the Path I dont like going direct to C: and the way you posted it I was not sure the exact format on that thus why I avoid it haha.

Yes it appears since your date in Cell E2 contains a / it is causing it to error. That is not a valid character for a filename, if you tried to save a file with the name MyFile/Pandas.xlsx this would error, so I switched the / for -

You may also get an error at the SaveAs code highlighted below as you may be saving in an odd format, for example I got a warning about saving a Macro file as .xlsx when I ran this. If you click yes you can just ignore it and save the file. You can also turn that off with Application.DisplayAlerts = False just be sure to turn it back on after you save.

Code:
Sub SaveFileButtonDateLCP40() '---LCP File Save---'
Dim SaveName As String
Const MyPath As String = [COLOR=#ff0000]"C:\Temp\"[/COLOR]
ReName:


    [COLOR=#ff0000]ValFrmSheet = Replace(Sheets("Sheet1").Range("E2").Value, "/", "-")[/COLOR]
    SaveName = "LCP Complete File " & Format(Now, "HH.MM.SS") & " - " & [COLOR=#ff0000]ValFrmSheet[/COLOR]
    If Len(SaveName) > 0 Then
        SaveName = SaveName &[COLOR=#ff0000] ".xlsx"[/COLOR]
        If Len(Dir(MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm"), vbDirectory)) = 0 Then
            MkDir MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\"
        End If
        If Len(Dir(MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\" & Format(Now, "mm") & "-" & Format(Now, "dd") & "-" & Format(Now, "yyyy"), vbDirectory)) = 0 Then
            MkDir MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\" & Format(Now, "mm") & "-" & Format(Now, "dd") & "-" & Format(Now, "yyyy") & "\"
        End If
[COLOR=#ff0000]       ActiveWorkbook.SaveAs Filename:=MyPath & Format(Now, "yy") & "-" & Format$(Now, "mmm") & "\" & Format(Now, "mm") & _[/COLOR]
[COLOR=#ff0000]           "-" & Format(Now, "dd") & "-" & Format(Now, "yyyy") & "\" & SaveName, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False[/COLOR]


    End If
    MsgBox "Savedin Folder"


Exit Sub


ErrorHandle:
    If Err.Number = 75 Then
        Resume Next
    ElseIf Err.Number = 1004 Then
        MsgBox ("That name is already used for this day. Please try again!")
        GoTo ReName
    Else: MsgBox ("There is an unknown error")
    End If
End Sub

Thanks for the reply this will help me. Also i save it as xlsx after the macro i run is close. I run a macro for a sheet i need then it copys and pastes the sheet i need to a new book which this save macro saves to a standard book and not a enablemacro book.
 
Upvote 0
Glad I could help - You actually showed me how to create a folder if one did not exist. Not something I have had to do before but nice to know :)
 
Upvote 0
Glad I could help - You actually showed me how to create a folder if one did not exist. Not something I have had to do before but nice to know :)

Its the best i use it for multiple sheets. It keeps things very orginized.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,021
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