Can I create a macro to find more than one possible date and change to current date?

[njmike]

I've been reading through these Word groups for a couple months now,
and I've found plenty of information and answers to my problems - up
until now. I've spent a fair amount of time trying to find a solution
to this, but I've been coming up with nothing so far, which I find
somewhat embarrassing, as I've this seems like it should be rather
simple.

I update forms all the time - all of which have a version date in the
footer of (mm/yy). I already have a basic macro that will open up the
footers, change the date, move to the next footer, repeat until
necessary, and then close the footer view. The problem is that I have
to constantly edit the macro so the dates are what I need. If I open
up a document with a (02/06) date, and my macro is set up to find
(01/06), I need to edit the macro.

I simply want a macro that will search and replace more possibilities
at once. Whether the form has a (01/06) date or a (02/06) date, I want
to change it to (03/06). I'd be happy opening up the code once month
and changing that (03/06) to whatever date it is at the time.
Currently, my code is:

ActiveWindow.ActivePane.View.SeekView = _
wdSeekCurrentPageFooter
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(01/06)"
.Replacement.Text = "(03/06)"
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.ActivePane.View.NextHeaderFooter
On Error Resume Next
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(01/06)"
.Replacement.Text = "(03/06)"
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.ActivePane.View.NextHeaderFooter
On Error Resume Next
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "(01/06)"
.Replacement.Text = "(03/06)"
End With
Selection.Find.Execute Replace:=wdReplaceAll
ActiveWindow.ActivePane.View.NextHeaderFooter
On Error Resume Next
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

The bulk of the command runs 3 times because I don't know if can get it
to loop properly otherwise. The "On Error Resume Next" is in there
because sometimes the document will be fewer pages than the instances
of the "ActiveWindow.ActivePane.View.NextHeaderFooter" command.
Without, I get an error message and the macro doesn't run properly.

Thanks in advance for any help. Until then, I'll continue to search.

- Mike

 

[Greg Maxey]

Try this. You shouldn't have to change your macro again unless you want to
change the format of your footer date:

Public Sub ScratchMacro()
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long

pFindTxt = "[0-9]{2}/[0-9]{2}"
pReplaceTxt = InputBox("Enter the replacement.", "REPLACE")
If pReplaceTxt = "" Then
MsgBox "Cancelled by User."
Exit Sub
End If
End If
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Process footer storytypes and linked footer stories
Select Case rngStory.StoryType
Case 8, 9, 11
Do
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Case Else
'Do Nothing
End Select
Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
End Sub

 

[njmike]

Thank you, Greg! That was almost perfect.

I say almost, because I made a couple little changes to suit my needs.
The macro has a popup box (which I kind of figured when I first saw the
code) that asks for the date. The thing is that I revise a lot of
forms, so I don't want to change that date every time I do a form. I
would prefer to edit the code once a month and be done. For that
reason, I changed the line that read
pReplaceTxt = InputBox("Enter the replacement.", "REPLACE")
to
pReplaceTxt = "03/06"
and then removed the "If... End If" statement below, as that seemed
unnecessary. My code - which works perfect - now reads as follows:

Sub Update_Version_Date_In_Footers()
'
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long

pFindTxt = "[0-9]{2}/[0-9]{2}"
pReplaceTxt = "03/06"
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections(1).Headers(1).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
'Process footer storytypes and linked footer stories
Select Case rngStory.StoryType
Case 8, 9, 11
Do
SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
'Get next linked story (if any)
Set rngStory = rngStory.NextStoryRange
Loop Until rngStory Is Nothing
Case Else
'Do Nothing
End Select
Next
End Sub
' Continuation of updating date in footer from above
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
.Text = strSearch
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll
End With
End Sub

I was worried that it would update dates in the entire document (not
just the footers), so I added something to the middle of the form as a
test and it didn't change! I don't how you did it, but it's great!!!!

One minor thing, though. Is there anyway to exclude one date? We have
an expiration date of (09/06) on a number of forms that I don't want
changed. If not, I can manually fix it when we do those, but it would
be a nice bonus if I could avoid that changing.

- Mike

 

[Greg]

Hmm...I thougth that I replied earlier.

For the minor thing, use this as your second macro:

' Continuation of updating date in footer from above
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
ByVal strSearch As String, _
ByVal strReplace As String)
With rngStory.Find
.ClearFormatting
.Replacement.ClearFormatting
.MatchWildcards = True
.Text = strSearch
.Replacement.Text = strReplace
While .Execute
If .Found Then
If rngStory <> "09/06" Then
rngStory = strReplace
rngStory.Collapse wdCollapseEnd
Else
rngStory.Collapse wdCollapseEnd
End If
End If
Wend
End With
End Sub

The reason only footers are processed is because of the Select Case
statement. While the macro itterates through all storytypes, it only
process 8, 9, and 11 which are the constant value for storytypes
wdEvenPagesFooter, wdPrimaryPagesFooter and wdFirstPageFooter. I use
the constants to save space.

 

[Greg]

About changing your macro once a month and changing the date every time
you do a form, It would be a small step to put all of the forms in one
directory then run a macro that changes all of the forms for you ;-)

 

[njmike]

Greg, you did it again. That was perfect!

As far as updating the macro once a month, I probably didn't explain my
purpose well enough. I work on forms all day long, whether it be
creating one from a template or revising one I made in the past.
Changing the templates once a month is not a problem, and it wasn't why
I wanted the macro developed. I was looking to streamline the process
of updating the ones I've done in the past. I may open up a form from
12/05 or from 03/04, but regardless - it needs to be changed to reflect
the date I'm revising it (03/06 for example; next month I'll change the
macro to read 04/06, so every form I work on will have the new date).

There are many, many forms that we have. We can't change the footers
on them because they need to reflect the last date they were revised.

Thanks again, Greg

- Mike

 

[Greg]

Got it. Glad to help.