Consulting

Results 1 to 18 of 18

Thread: Find the date and replace it 4x in a document

  1. #1
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location

    Find the date and replace it 4x in a document

    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

  2. #2
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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")
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  3. #3
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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?

  4. #4
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  5. #5
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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

  6. #6
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  7. #7
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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

  8. #8
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by wdg1 View Post
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  9. #9
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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

  10. #10
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    Quote Originally Posted by wdg1 View Post
    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?

    Quote Originally Posted by wdg1 View Post
    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}"
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  11. #11
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    Thanks a lot!

  12. #12
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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

  13. #13
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  14. #14
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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

  15. #15
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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
    Last edited by macropod; 02-26-2019 at 02:48 PM.
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  16. #16
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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

  17. #17
    Knowledge Base Approver VBAX Guru macropod's Avatar
    Joined
    Jul 2008
    Posts
    4,435
    Location
    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...
    Cheers
    Paul Edstein
    [Fmr MS MVP - Word]

  18. #18
    VBAX Regular
    Joined
    Oct 2018
    Location
    Antwerp
    Posts
    41
    Location
    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •