VBA replace old date with today's date (in the form of 29th July 2007)
Author: Suranthe de Silva
Rating:
Rate this Resource
Visits: 641
Discuss in Newsgroups
Sub Insert_Date()
'
' Insert_Date Macro
' Macro created 11/30/2006 by Suranthe de Silva
' Please note that this Macro finds the next number that is in the form of 200#
' and assumes that this is the date which is like: 2nd October 2007,
' it then replaces this with the current date. It is useful for people
' who write a lot of formal letters that are based on templates.
' This Macro finds a date that matches the syntax:
' <date Number>[superscript] <date Month> 200<0-9>
'
' <date Number> - 1, 2, etc...
' [superscript] - a superscript of the date is not compulsory
' <date Month> - Short or long form of the Month
' 200<0-9> - Only works for years 2000-2009
' Find a date that matches the given syntax: 2nd October 2007
Selection.Find.ClearFormatting
With Selection.Find
.Text = "200?"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveRight Unit:=wdWord, Count:=1
Selection.MoveLeft Unit:=wdWord, Count:=2, Extend:=wdExtend
If IsDate(Selection.Text) Then
Selection.MoveLeft Unit:=wdWord, Count:=1, Extend:=wdExtend
Selection.InsertDateTime DateTimeFormat:="d MMMM yyyy", _
InsertAsField:=False
Else
Selection.InsertDateTime DateTimeFormat:="d MMMM yyyy", _
InsertAsField:=False
End If
' Move into position to insert the superscript for the date number - 1st, 2nd..
Selection.MoveLeft Unit:=wdWord, Count:=2
Selection.MoveLeft Unit:=wdCharacter, Count:=1
' Get the required superscript depending on the date number
scrpt = ""
Select Case Day(Now())
Case 1, 21, 31
scrpt = "st"
Case 2, 22
scrpt = "nd"
Case 3, 23
scrpt = "rd"
Case Else 'th
scrpt = "th"
End Select
' Put down the superscript after the date number
Selection.Font.Superscript = wdToggle
Selection.TypeText Text:=scrpt
Selection.Font.Superscript = wdToggle
End Sub
Visit my guru profile
Visitor Comments
Be the first to rate this code sample!
