With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.
Sub Replacer() Dim tPath As String, tFile As String, ReplaceWhat As String, ReplaceWith As String, ReplaceWhat2 As String, ReplaceWith2 As String Dim wb As Workbook Dim ws As Worksheet Dim strFileName As String Dim strFile As String Dim pathDest As String Dim strD As Date Dim strMonth As Integer Dim strNewMonth As Integer 'Deal with this in case current date is January or February: Select Case Month(Date) Case 1 strMonth = 11 Case 2 strMonth = 12 Case Else strMonth = Month(Date) - 2 End Select Select Case Month(Date) Case 1 strNewMonth = 12 Case Else strNewMonth = Month(Date) - 1 End Select 'Change as required. This is the month name change ReplaceWhat = MonthName(strMonth) ReplaceWith = MonthName(strNewMonth) 'Change as required. This is to change the forecast name at beg of each quarter If strNewMonth < 4 Then ReplaceWhat2 = "Forecast 4" ReplaceWith2 = "Forecast 1" End If If strNewMonth > 3 And strNewMonth < 7 Then ReplaceWhat2 = "Forecast 1" ReplaceWith2 = "Forecast 2" End If If strNewMonth > 6 And strNewMonth < 10 Then ReplaceWhat2 = "Forecast 2" ReplaceWith2 = "Forecast 3" End If If strNewMonth > 9 And strNewMonth <= 12 Then ReplaceWhat2 = "Forecast 3" ReplaceWith2 = "Forecast 4" End If 'This is what we add to the name of each file strFileName = Left(ReplaceWith, 3) 'this is the source file location strFile = tPath & tFile 'Final destination for updated files pathDest = "C:\Documents and Settings\rstolly\Desktop\Final\" 'The path where your files are saved tPath = "C:\Documents and Settings\rstolly\Desktop\Source\" 'the *.* is all file types, *.xls will give you all xls files, *Reports.xls will give you all files ending with Reports.xls etc tFile = Dir(tPath & "*.xls") Do While Len(tFile) > 0 Set wb = Workbooks.Open(tPath & tFile) For Each ws In wb.Worksheets 'Assumes you have all data in the first sheet. Can be amended to loop through all sheets in workbook 'Set ws = wb.Sheets(1) ws.UsedRange.Replace ReplaceWhat, ReplaceWith ws.UsedRange.Replace ReplaceWhat2, ReplaceWith2 Next wb.SaveAs (pathDest & strFileName & Mid(tFile, 4, Len(tFile))) wb.Close True tFile = Dir Loop End Sub