Replacing multiple items with the same text

[cparsons]

I have a spreadsheet with a lot of look back formulas pointing to othe
sheets within the same workbook. Using a Macro I would like to chang
all the sheet names, in the formulas, to the same name. The shee
names I am working with are month names and would like to change al
the month names to the current month. This is what I currently have




Code
-------------------
With Worksheets("Approval_Sheet").Range("a1")
Cells.Replace What:="Oct!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Nov!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Dec!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Jan!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Feb!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Mar!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Apr!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="May!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Jun!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Jul!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Aug!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells.Replace What:="Sep!", Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End Wit
-------------------


Can I simplify this at all?

Thanks

 

[Dave Peterson]

Not sure why you have with/end with in there, but maybe...

Option Explicit
Sub testme01()

Dim iCtr As Long
Dim Cur_Month As String

Cur_Month = Format(Date, "mmm")

For iCtr = 1 To 12
Cells.Replace What:=Format(DateSerial(2004, iCtr, 1), "mmm") & "!", _
Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next iCtr

'xl2002 or higher (If I recall correctly)
For iCtr = 1 To 12
Cells.Replace What:=MonthName(Month:=iCtr, abbreviate:=True) & "!", _
Replacement:=Cur_Month & "!", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Next iCtr


End Sub

I think that MonthName was added in xl2002.