Microsoft Office Forums

Go Back   Microsoft Office Forums > >

 
 
Thread Tools Display Modes
Prev Previous Post   Next Post Next
  #2  
Old 05-14-2021, 06:54 AM
macropod's Avatar
macropod macropod is offline find/replace date format improvement? Windows 10 find/replace date format improvement? Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 22,467
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

For example:
Code:
Sub Demo()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Format = False
    .Forward = True
    .Wrap = wdFindContinue
    .MatchWildcards = True
    'Clean up UK format dates with ordinals
    .Text = "(<[0-9]{1,2})[dhnrst ]{1,3}([JFMASOND][abceghilmnoprstuvy]{2,8}>)"
    .Replacement.Text = "\1 \2"
    .Execute Replace:=wdReplaceAll
    'Clean up & reformat US format dates with/without ordinals
    .Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2})[dhnrst\-, ]@([12][0-9]{3}>)"
    .Replacement.Text = "\2 \1 \3"
    .Execute Replace:=wdReplaceAll
    .Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2})[dhnrst]@>"
    .Replacement.Text = "\2 \1"
    .Execute Replace:=wdReplaceAll
    .Text = "(<[JFMASOND][abceghilmnoprstuvy]{2,8})[- ]([0-9]{1,2}>)"
    .Execute Replace:=wdReplaceAll
    'Clean up & reformat D/M/YYYY & D-M-YYYY UK format dates
    .Text = "[0-9]{1,2}[/-][0-9]{1,2}[/-][12][0-9]{3}>"
    .Replacement.Text = ""
  End With
  Do While .Find.Execute = True
    .Text = Format(.Text, "D MMMM YYYY")
    .Collapse wdCollapseEnd
  Loop
End With
With ActiveDocument.Range
  With .Find
    .MatchWildcards = True
    'Apply superscripted ordinals to all dates
    .Text = "<[0-9]{1,2} [JFMASOND][abceghilmnoprstuvy]{2,8}>"
    .Wrap = wdFindStop
  End With
  Do While .Find.Execute = True
    i = CLng(Split(.Text, " ")(0))
    .Text = Ordinal(i) & " " & Split(.Text, " ")(1)
    With .Duplicate
      .Start = .Start + Len(CStr(i))
      .End = .Start + 2
      .Font.Superscript = True
    End With
    .Collapse wdCollapseEnd
  Loop
End With
Application.ScreenUpdating = True
End Sub

Function Ordinal(i As Long) As String
Dim strOrd As String
If (i Mod 100) < 11 Or (i Mod 100) > 13 Then strOrd = Choose(i Mod 10, "st", "nd", "rd") & ""
Ordinal = i & IIf(strOrd = "", "th", strOrd)
End Function
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
 

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Mail merge field mistakenly interpret text format as date format alan6690 Mail Merge 0 09-02-2020 01:54 AM
Find/Replace using format of cell catflap Excel 1 09-11-2017 07:28 AM
Letter date changes when merging with Excel - not the format, the actual date! Smallweed Mail Merge 1 02-07-2014 06:00 PM
find/replace date format improvement? Find and Replace maintain format winningson Word 3 01-19-2013 05:38 AM
find/replace date format improvement? Find and Replace Format macro issue Jack Word VBA 2 12-12-2012 09:24 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 02:51 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft