Need Macro help to Convert date to text

K

Kim

Below is is my macro to find the date in the current selection only
and convert it to text. I am having two problems.

1. I don't want to be asked if I want to find and replace thoughout
the document, so I need to have Screen updating off. The first time I
run this macro in a document I do not have a problem. The second time
I run the macro it asks me if I want to search and replace throughout
the rest of the document. Which is not what I need.


2. Now this macro is changing my 01/01/06 dates to October 1, 2006
and
I can't see why.


Please help!!


Sub Convert_MMDDYY_to_Text()


Application.ScreenUpdating = False
Selection.ClearFormatting


Selection.Find.Execute FindText:="<[01]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="January \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[12]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="December \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[11]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="November \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[10]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="October \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[09]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="September \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[08]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="August \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[07]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="July \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[06]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="June \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[05]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="May \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[04]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="April \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[03]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="March \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[02]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="February \1, 20\2",
Replace:=wdReplaceAll
 
K

Kim

Below is is my macro to find the date in the current selection only
and convert it to text. I am having two problems.

1. I don't want to be asked if I want to find and replace thoughout
the document, so I need to have Screen updating off. The first time I
run this macro in a document I do not have a problem. The second time
I run the macro it asks me if I want to search and replace throughout
the rest of the document. Which is not what I need.

2. Now this macro is changing my 01/01/06 dates to October 1, 2006
and
I can't see why.

Please help!!

Sub Convert_MMDDYY_to_Text()

Application.ScreenUpdating = False
Selection.ClearFormatting

Selection.Find.Execute FindText:="<[01]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="January \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[12]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="December \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[11]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="November \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[10]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="October \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[09]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="September \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[08]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="August \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[07]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="July \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[06]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="June \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[05]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="May \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[04]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="April \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[03]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="March \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[02]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="February \1, 20\2",
Replace:=wdReplaceAll
Click to expand...

One more thing, the replace is changing everywhere in the document, I
just want my highlighted selection!
 
D

Doug Robbins - Word MVP

Use:

Dim trange As Range
Dim frange As Range
Set frange = Selection.Range
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:="[0-9]{1,2}\/[0-9]{1,2}\/[0-9]{2,4}",
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set trange = Selection.Range
If trange.Start < frange.End Then
trange.Text = Format(trange.Text, "MMMM dd, yyyy")
Else
Exit Sub
End If
Loop
End With


--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP

Kim said:
Below is is my macro to find the date in the current selection only
and convert it to text. I am having two problems.

1. I don't want to be asked if I want to find and replace thoughout
the document, so I need to have Screen updating off. The first time I
run this macro in a document I do not have a problem. The second time
I run the macro it asks me if I want to search and replace throughout
the rest of the document. Which is not what I need.

2. Now this macro is changing my 01/01/06 dates to October 1, 2006
and
I can't see why.

Please help!!

Sub Convert_MMDDYY_to_Text()

Application.ScreenUpdating = False
Selection.ClearFormatting

Selection.Find.Execute FindText:="<[01]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="January \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[12]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="December \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[11]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="November \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[10]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="October \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[09]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="September \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[08]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="August \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[07]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="July \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[06]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="June \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[05]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="May \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[04]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="April \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[03]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="March \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[02]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="February \1, 20\2",
Replace:=wdReplaceAll
Click to expand...

One more thing, the replace is changing everywhere in the document, I
just want my highlighted selection!
Click to expand...
 
K

Kim

Use:

Dim trange As Range
Dim frange As Range
Set frange = Selection.Range
Selection.Find.ClearFormatting
With Selection.Find
Do While .Execute(FindText:="[0-9]{1,2}\/[0-9]{1,2}\/[0-9]{2,4}",
MatchWildcards:=True, Wrap:=wdFindStop, Forward:=True) = True
Set trange = Selection.Range
If trange.Start < frange.End Then
trange.Text = Format(trange.Text, "MMMM dd, yyyy")
Else
Exit Sub
End If
Loop
End With

--
Hope this helps.

Please reply to the newsgroup unless you wish to avail yourself of my
services on a paid consulting basis.

Doug Robbins - Word MVP




Below is is my macro to find the date in the current selection only
and convert it to text. I am having two problems.
1. I don't want to be asked if I want to find and replace thoughout
the document, so I need to have Screen updating off. The first time I
run this macro in a document I do not have a problem. The second time
I run the macro it asks me if I want to search and replace throughout
the rest of the document. Which is not what I need.
2. Now this macro is changing my 01/01/06 dates to October 1, 2006
and
I can't see why.
Please help!!
Sub Convert_MMDDYY_to_Text()
Application.ScreenUpdating = False
Selection.ClearFormatting
Selection.Find.Execute FindText:="<[01]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="January \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[12]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="December \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[11]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="November \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[10]{2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="October \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[09]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="September \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[08]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="August \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[07]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="July \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[06]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="June \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[05]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="May \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[04]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="April \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[03]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="March \1, 20\2",
Replace:=wdReplaceAll
Selection.Find.Execute FindText:="<[02]{1,2}/([0-9]{1,2})/([0-9]
{2,4})", MatchWildcards:=True, Replacewith:="February \1, 20\2",
Replace:=wdReplaceAll
Click to expand...
Click to expand...
One more thing, the replace is changing everywhere in the document, I
just want my highlighted selection!- Hide quoted text -
Click to expand...

- Show quoted text -
Click to expand...

Doug,

That worked, and REALLY well! I see I have a long way to go before
starting getting the correct way write VBA macros! I really appreciate
you help! BIG THANKS!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Change a great number of words in word files, with a macro as short as possible. 5
Convert MMDDYY to Text--Need with with my Macro 1
Word macro that can call cells out of Excel for a find and replace 0
CleanUpPastedText() 1
Select Text to End of Footnote 9
Word Macro 2003-2007 problem 0
Convert Windows Macro for use in Mac Word 1
Find "Out of" then a comma then Delete 2

Top