Find the date and replace it 4x in a document

[wdg1]

I want to search a "date" in my document. This date is 4x (the same date) in the document.
I want to change this in today's date.
The first date (to be found) is noted down as:
Date study: 02/01/2019.
This is a flemish (Belgium, Europe) notification, the 2nd of January, 2019.

Having started it in programming in VBA, things went wrong.
I declared some variables:
Dim strToday As String
Let strToday = Format(Now, "dd/mm/yyyy")


But: how do I select the "date" after the ":".
This must then be stored in a variable.
This variable can than be changed to strToday.

-what I made so far- but is not correct.
--------------------------------------------------
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "Datum onderzoek:"
.Replacement.Text = "woensdag 20 februari 2019"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.MoveRight Unit:=wdWord, Count:=5, Extend:=wdExtend
Selection.Copy
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "16/03/2019"
.Replacement.Text = strToday
.Forward = True
.Wrap = wdFindAsk
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
End Sub

[macropod]

It is unclear what you're trying to achieve. Perhaps something along the lines of:

Sub Demo()
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "(Datum onderzoek: )[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
.Replacement.Text = "\1" & Format(Now, "dd/mm/yyyy")
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End Sub
For the full date as the output, you might use:

.Replacement.Text = "\1" & Format(Now, "dddd, d mmmm yyyy")

[wdg1]

Thanks.
This works 90%. Great!
The old date, 16/03/2018 (that is March 16th 2018) is now replaced by today's date.
But todays date is 21/02/2019. After the macro has run, the new date is noted down as 21-02-2019.
That means that the next time I have to change the date (following week, when I open this document and the date has to change), the macro can not read the date 21-02-2019, and will not run.
So today's date has to be formatted 21/02/2019 and not 21-02-2019.
How to change this?

[macropod]

Presumably, the separator has changed because that's what you have in your system's regional settings. Regardless, you can work around that in either of two ways:
1. Change -
.Text = "(Datum onderzoek: )[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
to -
.Text = "(Datum onderzoek: )[0-9]{1;2}[\-/][0-9]{1;2}[\-/][0-9]{4}"
This enables the macro to find dates formatted as either 21/02/2019 or 21-02-2019
2. Change -
Replacement.Text = "\1" & Format(Now, "dd/mm/yyyy")
to -
Replacement.Text = "\1" & Replace(Format(Now, "dd/mm/yyyy"), "-", "/")
This forces the output be like 21/02/2019.

[wdg1]

Thanks, this works 100%. Great job.
One last thing.
At the end of the document is my signature, and thr date.
In the macro, all dates are changed, but not the date at the end.
This is, because this date is not after the (Flemisch/Begium words) "datum onderzoek:"
The US/UK translation for "datum onderzoek" is "date of examination", which means date of medical examination.
Is there a way to select the first date in the document, which can be found after "datum onderzoek:", then submit this to a variabe, then search the whole document for this variable, and then replace this by "today's date".
This would work the macro in my document for 100%.
Ward

[macropod]

You could, of course, avoid the need for a macro by having DATE or CREATEDATE fields wherever you want the date to appear. If you're using a template (as you should), CREATEDATE fields will output whatever date the document you're writing is created. If you use DATE fields, however, the date will update every time the document is opened. There are also PRINTDATE and SAVEDATE fields that can be used if the circumstances require.


If none of those is suitable, you'll need to tell me whether every date in the document is to be changed and, if not, what text precedes the additional date.

[wdg1]

Thanks, Paul, for clarifying the Date formatting in WORD.
My workflow is that in my job, I have to make 4x a document, because I work on this documents 4x, eacht month 1x.
My workflow is to make a copy of the previous file, and rename it as new document (this is generated by my (medical) software).
So far so good.
Now comes the job.
In this document, the date of the (previous) work session, has to be changed, 4x in this document.
Yes, the first date to be changed, can be found after the words "Datum onderzoek" (in UK English: Date of examination).
Further in the document, I have (date of "sending of this document").
Yes, It can be adapted from your nice written VBA, this is not so difficult.
Now comes the hard part.
Two pages before the ending AND at the ending, so two times,
the document ends by, "Yours sincerely", vbCr, [Ny Name], vbCr, Date.
For instance:
Yours sincerely,
My_forename My_Name
Date
My forename name is written in tree parts (John De Mol).
...which is not my real name ;-)... it is an example.
The question is if this can be done in VBA.
Yes I have a secret way to do it: before the date, I can type "Datum onderzoek: " and use here a font size of 1 (which will be then not visible...).
With the vba code you wrote I could fix it... but a nice VBA code would be preferred.
Thanks again.
Ward

[macropod]

My workflow is to make a copy of the previous file, and rename it as new document (this is generated by my (medical) software).

That really is poor practice. Creating a new document from a template is the correct way to do things. Amongst other things, doing it that way eliminates the risk that someone will simply change an existing document without saving under the new name. That said, given your current process, you could use:


Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Replacement.Text = "\1" & Replace(Format(Now, "dd/mm/yyyy"), "-", "/")
.Text = "(Datum onderzoek: )[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
.Execute Replace:=wdReplaceAll
.Text = "(Yours sincerely^13*^13)[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
.Execute Replace:=wdReplaceAll
End With
Application.ScreenUpdating = True
End Sub
Presumably, you'll want to change 'Yours sincerely' to whatever that paragraph actually contains.

[wdg1]

Hello,
A quick answer to my (poor?) practice:
In my medical software, a template is standard for all documents.
So my first document, based on that tempalte is immediaztely stored as new document with an unique name.
The followoing documents (for this patient), based on this first document, which are copies, are opend as copy and stored immedatily as an unique name.
As patienst are seen 4x -> 10X, each document has to be saved, and each time the document grows (new inforamtion is added).
Let's return to my question.
The question was, that in building this new document based on the previous, I have to change 4x the previous date in today's date.
In Word I select the "date", then Ctrl-H, with find and replace, the new date (today's date) is added.
I am building a macro to automate this.
The 4 dates to change are at random in the document.
Sometimes this date as noted down after some words, sometimes not.
The suggested macro line
Text = "(Yours sincerely^13*^13)[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
did not work.
This depents on vbCr (or not) and is not consistent in the document.
I was thinking to put the "first date" in my document in a variable.
Example:
dim strToday As String
dim strOldDate As String
Let strToday = format(Now, "dd/mm/yyy")
Let strOldDate = format(Now, "dd/mm/yyy")
The first date can be found after "wordA wordB:space date" whereas the date is in Europe Belgium dd/mm/yyy.
By using input or something else, the found "olddate" (after wordA wordB:space date) can be added as variable.
Then Find and replace must be started with using of the variables strOldDate and strToday.
Thanks,
Ward

[macropod]

The 4 dates to change are at random in the document.
Sometimes this date as noted down after some words, sometimes not.

So, does the macro work for all dates other than the final date?


The suggested macro line
Text = "(Yours sincerely^13*^13)[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
did not work.
This depents on vbCr (or not) and is not consistent in the document.

In that case, you might try:
.Text = "(Yours sincerely*)[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"

[wdg1]

Thanks a lot!

[wdg1]

Last thing to be changed, is in the footer, which starts at page 2, to change the OldDate to Today's date.
The date to be changed - in the footer -starts after the (flemisch/ Belgium) words, Datum onderzoek:
Thanks, Ward

[macropod]

You don't need a macro for that, simply apply a unique Style name to any of the applicable 'Datum onderzoek: dd/mm/yyyy' strings in the document body, then reference that Style via a STYLEREF field in the footer. Then, whenever that date is updated, the footer will update also.

[wdg1]

Yes, indeed. That seems logic for new documents.
But I have lot's of old documents, the old date is already in the footer.
I have a macro to change that, this macro works with range.
Problem 1: after prosecuting this macro, my cursor "hangs" in the footer instead of returning to the document.
Problem 2: the existing pagenumber in the footer is deleted, also all the existing lines are deleted
In the footer was writen down:
Datum onderzoek: 25/02/219
Dr med John De Mol
[tab right aligment] pagenumber

Here is the macro
Sub ChangeFooterOldDateToTodaysDate()
Dim oRng As Range
Dim oHeader As HeaderFooter

Selection.HomeKey Unit:=wdStory

Selection.Find.ClearFormatting
With Selection.Find
.Text = "Datum onderzoek:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = True
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=2
Selection.MoveRight Unit:=wdWord, Count:=5, Extend:=wdExtend
Selection.Copy


Set oRng = Selection.Range
Set oHeader = oRng.Sections(1).Footers(wdHeaderFooterPrimary)

Application.Browser.Next
Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:="2"
Selection.Find.ClearFormatting


oHeader.Range.FormattedText = oRng.FormattedText
oRng.Text = ""
Set oRng = Nothing
Set oHeader = Nothing


End Sub
Thanks for any kind help.
Ward

[macropod]

Try:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument
With .Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Format = False
.Wrap = wdFindContinue
.MatchWildcards = True
.Replacement.Text = "\1" & Replace(Format(Now, "dd/mm/yyyy"), "-", "/")
.Text = "(Yours sincerely^13*^13)[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
.Execute Replace:=wdReplaceAll
.Text = "(Datum onderzoek: )[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
.Execute Replace:=wdReplaceAll
End With
With .StoryRanges(wdPrimaryFooterStory).Find
.MatchWildcards = True
.Text = "(Datum onderzoek: )[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
.Replacement.Text = "\1" & Replace(Format(Now, "dd/mm/yyyy"), "-", "/")
.Execute Replace:=wdReplaceAll
End With
End With
Application.ScreenUpdating = True
End Sub

[wdg1]

Thank you for this nice answer and nice code.
However, the code does not work.
The footer to be changed is not in the VBA code, so I changed
With .StoryRanges(wdPrimaryHeaderStory).Find
to
With .StoryRanges(wdPrimaryFooterStory).Find
This works when the date in the footer is 26/02/2019.
I checked it, and this works great!
But the date in the footer is noted down as dd mmmm yyyy, so as 26 februari 2018.
A little fine-tuning would make this nice VBA to work 100%.
Can you review it?
Thanks, Ward

[macropod]

Replace:

With .StoryRanges(wdPrimaryFooterStory).Find
.MatchWildcards = True
.Text = "(Datum onderzoek: )[0-9]{1;2}/[0-9]{1;2}/[0-9]{4}"
.Replacement.Text = "\1" & Replace(Format(Now, "dd/mm/yyyy"), "-", "/")
.Execute Replace:=wdReplaceAll
End With
End With
with:

With .StoryRanges(wdPrimaryFooterStory).Find
.MatchWildcards = True
.Text = "(Datum onderzoek: )[0-9]{1;2} <*> [0-9]{4}"
.Replacement.Text = "\1" & Format(Now, "d mmmm yyyy")
.Execute Replace:=wdReplaceAll
End With
End With
You could even use:
[adfjmnos][abceéilmnoprstuûv]{2;8}
instead of:
<*>
but that's probably overkill...

[wdg1]

Yes, this works perfect. I am using this code for 2 weeks, no errors at all. It works 100%. So, you nailed it. This rocks ! Thanks very much! Ward