Quick Macro Help

[Jar888]

Hi all. Running currently the below macro;

Sub PRODTRACKSummary_Button1_Click()
Application.ScreenUpdating = False
Dim PS As String
Dim SavePath As Variant
Dim FileName As String

Val2 = Format(Range("D1").Value, "ddmmyyyy")


PS = Left(ActiveSheet.Name, 4)
SavePath = "F:\Data\2579\13 Progress Reporting Programming\03 Daily Diary\Lateral Development\Current Month\Prodtrack Summary"
ActiveSheet.Copy
ActiveWorkbook.SaveAs FileName:= _
SavePath & "\" & Val2 & " " & "ProdTrak Summary" & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
ActiveWindow.Close
Application.ScreenUpdating = True
End Sub

I want to change the masterdate after each save, but the addition was crashing my VBA macros.

Range("D1") = Range("D1") + 1

Can anyone help me with this? Also, how would I add a pop up to confirm data input prior to executing the save function?

 

[rlv01]

Maybe something like this.

Sub PRODTRACKSummary_Button1_Click()
    Dim SavePath As String, FileName As String
    Dim WS As Worksheet
    Dim MasterDate As Date
    
    Application.ScreenUpdating = False
    Set WS = ActiveSheet
    
    MasterDate = WS.Range("D1").Value
    FileName = Format(MasterDate, "ddmmyyyy") & " " & "ProdTrak Summary.xlsx"
    SavePath = "F:\Data\2579\13 Progress Reporting Programming\03 Daily Diary\Lateral Development\Current Month\Prodtrack Summary"
    SavePath = SavePath & "\" & FileName
    
    Select Case MsgBox("Master Date: " & WS.Range("D1").Value & vbCrLf & vbCrLf _
            & "File Name: " & FileName & vbCrLf & vbCrLf _
            & "SavePath: " & SavePath & vbCrLf & vbCrLf _
            & "Continue?", vbYesNo Or vbQuestion, Application.Name)
        Case vbYes
            ActiveSheet.Copy
            ActiveWorkbook.SaveAs FileName:=SavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
            ActiveWorkbook.Close False
            WS.Range("D1").Value = MasterDate + 1 'increment date
    End Select
    Application.ScreenUpdating = True
End Sub
End Sub

 

[Jar888]

Thanks mate! Your a life saver. I changed the wording in the pop up but otherwise she looks like she works every time and increments the date.

 

[rlv01]

Glad it worked for you.

 

[Jar888]

Got a follow up question,

is there a way to add to the code to automatically accept this pop up;

 

[rlv01]

Use Application.DisplayAlerts. Example:

    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=SavePath, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    Application.DisplayAlerts = True