Having trouble with vba code

[Tmcgrew05]

Sub OpenAndSaveAsNextMonth()

' Define variables
Dim currentMonth As String
Dim nextMonth As String
Dim filePath As String
Dim fileName As String
Dim currentWorkbook As Workbook
Dim nextWorkbook As Workbook

' Define file path and file name
filePath = "X:\Plant-Flora\Assembly-Flora\Public\Mike Prosser\Manning Actual\"
fileName = "March 2023 KPI manning Rev 2d.xlsm"

' Get current month and next month
currentMonth = Format(Date, "mmmm yyyy")
nextMonth = Format(DateAdd("m", 1, Date), "mmmm yyyy")

' Check if it is the 3rd day of the current month
If Day(Date) = 3 Then

' Open the current month file
Set currentWorkbook = Workbooks.Open(filePath & fileName)

' Save as the next month
currentWorkbook.SaveAs filePath & Replace(fileName, currentMonth, nextMonth), 52

' Update cell D2 on sheet 2 to the next month
currentWorkbook.Sheets("2").Range("D2").Value = DateSerial(Year(currentWorkbook.Sheets("2").Range("D2").Value), Month(currentWorkbook.Sheets("2").Range("D2").Value) + 1, 1)

' Update cell D2 on summary sheet to represent month in number form
currentWorkbook.Sheets("Summary").Range("D2").Value = Month(currentWorkbook.Sheets("2").Range("D2").Value)

' Close the next month file and save changes
Application.DisplayAlerts = False ' Suppress save prompt
currentWorkbook.Close SaveChanges:=True
Application.DisplayAlerts = True ' Reset save prompt

End If

End Sub

The bold part of the code is causing an error. I am trying to leave my March file open after the April file has been created, updated, saved and closed. However, it will either leave the April file open, both files open or close both and leave a blank excel open. Please help correct.

 

[dmt32]

Hi,
untested but see if this update to your code will do what you want

Sub OpenAndSaveAsNextMonth()
    
    ' Define variables
    Dim currentMonth           As String, nextMonth  As String
    Dim fileName               As String, newfilename As String
    Dim msg                    As String
    Dim wbCurrentmonth         As Workbook, wbNextMonth As Workbook
    
    ' Define file path and file name
    Const filePath  As String = "X:\Plant-Flora\Assembly-Flora\Public\Mike Prosser\Manning Actual\"
    
    ' Get current month and next month
    currentMonth = Format(Date, "mmmm yyyy")
    nextMonth = Format(DateAdd("m", 1, Date), "mmmm yyyy")
    
    fileName = "March 2023 KPI manning Rev 2d.xlsm"
    
    newfilename = Replace(fileName, currentMonth, nextMonth)
    
    On Error GoTo myerror
    ' Check if it is the 3rd day of the current month
    If Day(Date) = 3 Then
        
        ' Open the current month file
        Set wbCurrentmonth = Workbooks.Open(filePath & fileName)
        
        ' Save copy  as the next month
        wbCurrentmonth.SaveCopyAs filePath & newfilename
        
        With Application
            ' Suppress save prompt
            .DisplayAlerts = False: .ScreenUpdating = False
        End With
        
        'open next month workbook
        Set wbNextMonth = Workbooks.Open(filePath & newfilename)
        
        'apply updates
        With wbNextMonth
            
            With .Worksheets("2").Range("D2")
                ' Update cell D2 on sheet 2 to the next month
                .Value = DateSerial(Year(.Value), Month(.Value) + 1, 1)
            End With
            
            ' Update cell D2 on summary sheet to represent month in number form
            With .Sheets("Summary").Range("D2")
                .Value = Month(.Value)
            End With
            
        End With
        'create msg prompt
        msg = newfilename & Chr(10) & "New Workbook Saved"
    End If
    
myerror:
    'close workbook & save if no error
    If Not wbNextMonth Is Nothing Then wbNextMonth.Close Err = 0
    
    With Application
        .DisplayAlerts = True: .ScreenUpdating = True
    End With
    
    'report errors
    If Err <> 0 Then MsgBox (Error(Err)), 48, "Error": Exit Sub
     'inform user
    If Len(msg) > 0 Then MsgBox msg, 64, "New Workbook"
   
End Sub

Dave