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

Z

zone709

Well-known Member
Joined
Mar 1, 2016
Messages
2,125
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

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Sort by date Sort by votes
Code: 
SaveName = "LCP Complete File " & Format(Now, "HH.MM.SS") & " - " & Sheets("Sheet1").Range("E2").Value
.
 
Last edited:
Upvote 0
Coding4Fun said:
Code: 
SaveName = "LCP Complete File " & Format(Now, "HH.MM.SS") & " - " & Sheets("Sheet1").Range("E2").Value
.
Click to expand...

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
Coding4Fun said:
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
Click to expand...

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
Coding4Fun said:
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 :)
Click to expand...

Its the best i use it for multiple sheets. It keeps things very orginized.
 
Upvote 0
You must log in or register to reply here.

Similar threads

W
  • Solved
Modify Column format before saving as csv file
2
Replies
12
Views
943
WascoWarrior
W
J
  • Question Question
VBA for Excel used to work, doesn't now
Replies
1
Views
215
Joe4
Joe4
P
  • Question Question
Signature is being removed when I run the rest of my VBA
Replies
3
Views
547
rollis13
rollis13
S
  • Question Question
Change the date format after copying from Excel workbook to Word file
Replies
1
Views
227
Rhodie72
Rhodie72
S
  • Solved
Miscrosoft has Blocking The Macro Sometimes and disabling the macros
Replies
5
Views
665
NdNoviceHlp
NdNoviceHlp

Forum statistics

Threads
1,223,905
Messages
6,175,297
Members
452,633
Latest member
DougMo

Share this page

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