Replace current month in formulas and text to next Month in files in Folder

[A A Ron]

I am having an issue with this macro. I am trying to change the Months (in formulas and text) from all the files in this folder to the next month. This is so that when I do the reporting I simply need to run this macro and it will update all the files in the folder.

The issue that I am having, is that some of the files have more than one sheet, and when that is the case, it seems that the replace all runs more than once. If the workbook has two sheets it will run twice for that workbook and skip ahead two months instead of one.

any ideas would be greatly appreciated! Thank You in advance.

Sub BalancedScorecard_ReplaceThroughSheets()




Dim ws As Worksheet
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog






'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  
'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx"


'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)


'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
      Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Change Each Worksheet in folder to be only values, and each sheet pw protected to be "fpd"
    For Each ws In ActiveWorkbook.Worksheets
        If Range("A2").Value = "December" Then
            Cells.Select
            Selection.Replace What:="December", Replacement:="February", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False


        ElseIf Range("A2").Value = "February" Then
            Cells.Select
            Selection.Replace What:="February", Replacement:="March", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False


        ElseIf Range("A2").Value = "March" Then
            Cells.Select
            Selection.Replace What:="March", Replacement:="April", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False


        ElseIf Range("A2").Value = "April" Then
            Cells.Select
            Selection.Replace What:="April", Replacement:="May", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            
        ElseIf Range("A2").Value = "May" Then
            Cells.Select
            Selection.Replace What:="May", Replacement:="June", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False


        ElseIf Range("A2").Value = "June" Then
            Cells.Select
            Selection.Replace What:="June", Replacement:="July", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            
        ElseIf Range("A2").Value = "July" Then
            Cells.Select
            Selection.Replace What:="July", Replacement:="August", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            
        ElseIf Range("A2").Value = "August" Then
            Cells.Select
            Selection.Replace What:="August", Replacement:="September", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False


        ElseIf Range("A2").Value = "September" Then
            Cells.Select
            Selection.Replace What:="September", Replacement:="October", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False


        ElseIf Range("A2").Value = "October" Then
            Cells.Select
            Selection.Replace What:="October", Replacement:="November", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            
        ElseIf Range("A2").Value = "November" Then
            Cells.Select
            Selection.Replace What:="November", Replacement:="December", LookAt:= _
            xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False


Else
End If
    Next ws
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents


    'Get next file name
      myFile = Dir
  Loop


'Message Box when tasks are completed
  MsgBox "Task Complete!"


ResetSettings:
  'Reset Macro Optimization Settings
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.AskToUpdateLinks = True
End Sub

 

[gallen]

So does cell A2 on each sheet only contain the full named month?

 

[A A Ron]

Yes, I have that as a Data Validation Dropdown. It is connected to the table headings. The formulas that need the month's replaced are in the tables.

 

[gallen]

Try this. Not been able to test but played it through and should work. Removes need of going theough all the If/ElseIf stuff (Higlighted in red the addition I made)

Sub BalancedScorecard_ReplaceThroughSheets()

Dim ws As Worksheet
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim d As Date
Dim sNextMonth As String

'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  
'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx"




'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)


'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Change Each Worksheet in folder to be only values, and each sheet pw protected to be "fpd"
    For Each ws In ActiveWorkbook.Worksheets
    
        [B][COLOR=#ff0000]'get the first of the month in A2
        d = CDate("1 " & Range("A2") & " " & Year(Now))
        'Add 1 month to it
        d = DateAdd("m", 1, d)
        'Get the month in a string
        sNextMonth = Format(d, "mmmm")
        
        Cells.Select
        Selection.Replace What:=Range("A2").Value, Replacement:=sNextMonth, LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False[/COLOR][/B]
            
    Next ws
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents


    'Get next file name
      myFile = Dir
  Loop


'Message Box when tasks are completed
  MsgBox "Task Complete!"


ResetSettings:
  'Reset Macro Optimization Settings
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.AskToUpdateLinks = True
End Sub

 

[gallen]

Also the previous code in red could be condensed further:

Sub BalancedScorecard_ReplaceThroughSheets()

Dim ws As Worksheet
Dim wb As Workbook
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim FldrPicker As FileDialog
Dim sNextMonth As String


'Optimize Macro Speed
  Application.ScreenUpdating = False
  Application.EnableEvents = False
  Application.Calculation = xlCalculationManual
  Application.AskToUpdateLinks = False
  Application.DisplayAlerts = False
  
'Retrieve Target Folder Path From User
  Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)


    With FldrPicker
      .Title = "Select A Target Folder"
      .AllowMultiSelect = False
        If .Show <> -1 Then GoTo NextCode
        myPath = .SelectedItems(1) & "\"
    End With


'In Case of Cancel
NextCode:
  myPath = myPath
  If myPath = "" Then GoTo ResetSettings


'Target File Extension (must include wildcard "*")
  myExtension = "*.xlsx"


'Target Path with Ending Extention
  myFile = Dir(myPath & myExtension)


'Loop through each Excel file in folder
  Do While myFile <> ""
    'Set variable equal to opened workbook
    Set wb = Workbooks.Open(Filename:=myPath & myFile)
    
    'Ensure Workbook has opened before moving on to next line of code
      DoEvents
    
    'Change Each Worksheet in folder to be only values, and each sheet pw protected to be "fpd"
    For Each ws In ActiveWorkbook.Worksheets
        
[B][COLOR=#008080]        'Get the next month after month in A2[/COLOR][COLOR=#ff0000]
        sNextMonth = Format(DateAdd("m", 1, CDate("1 " & Range("A2") & " " & Year(Now))), "mmmm")[/COLOR][/B]
        
        Cells.Select
        Selection.Replace What:=Range("A2").Value, Replacement:=sNextMonth, LookAt:= _
        xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
            
    Next ws
    
    'Save and Close Workbook
      wb.Close SaveChanges:=True
      
    'Ensure Workbook has closed before moving on to next line of code
      DoEvents


    'Get next file name
      myFile = Dir
  Loop


'Message Box when tasks are completed
  MsgBox "Task Complete!"


ResetSettings:
  'Reset Macro Optimization Settings
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    Application.AskToUpdateLinks = True
End Sub

 

[A A Ron]

gallen, that worked, but I still have the issue I was having. I have one Workbook that has 3 sheets. It was run with July being in all of the formulas, and turned out at the end to have October running in all of the formulas/text.

Thank You.