[RESOLVED] Remove Ordinal Suffix

Hello to those of superior intelect!

I am working with a program which creates word documents with dates in the format 4th June 2011 (the suffix is not superscripted) and I need to be able to change the date format to 4 June 2011.

My question is this; 'How do I remove the ordinal suffix?'

I have the following code (it continues until 31) which does work but I was wondering if anyone knows of a tidier and/or more efficient way of solving it (I'm sure there is!):

Code:

---

Sub Ordinals()

    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    Selection.Find.Replacement.Font.Underline = wdUnderlineNone
    With Selection.Find
        .Text = "1st"
        .Text = "2nd"
        .Replacement.Text = "2"
        .Forward = True
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
       
    Selection.Find.Execute Replace:=wdReplaceAll
           
    Selection.HomeKey Unit:=wdStory

        .Text = "Engaged"
        .Replacement.Text = "Engaged -"
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
       
    Selection.Find.Execute Replace:=wdReplaceAll
               
    Selection.HomeKey Unit:=wdStory

        .Text = "% *"
        .Replacement.Text = "%"
        .Forward = True
        .Format = False
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
       
    Selection.Find.Execute Replace:=wdReplaceAll
   
    End With
        Selection.WholeStory
        Selection.ParagraphFormat.Alignment = wdAlignParagraphJustify
        Selection.HomeKey Unit:=wdStory
   
   
End Sub

---

Obviously bear in mind that there are words such as 'then' 'stick' and 'sand' where I do not want the th, st and nd removed.

Here is one way.

Tested it with this text in the word document.

Quote:

---

This is an example with the words then stick and sand and the dates which are
1st June 2010
2nd June 2010
10th June 2010

---

HTH

Sid

Code Used

Code:

---

Sub Sample()
    Dim A(10) As String

    A(1) = "1st"
    A(2) = "2nd"
    A(3) = "3rd"
    A(4) = "4th"
    A(5) = "5th"
    A(6) = "6th"
    A(7) = "7th"
    A(8) = "8th"
    A(9) = "9th"
    A(10) = "0th"

    For i = 1 To 10
        Selection.Find.ClearFormatting
        Selection.Find.Replacement.ClearFormatting
        With Selection.Find
            .Text = A(i)
            .Replacement.Text = Left(A(i), 1)
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        Selection.WholeStory
    Next i
End Sub

---

here is another method you can try, i tested with sids sample text

vb Code:

Dim d As Range, w As Range
Set d = ActiveDocument.Content
 For Each w In d.Words
    If Right(w.Text, 4) Like "#?? " Then
        w = Left(w, Len(w) - 3) & " "
    End If
 Next

Another way with a single complicated search string:

Code:

---

    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "([0-9])([snrt][tdh]) (<[AFJMNSOD]*>) ([0-9]{4})"
        .Replacement.Text = "\1 \3 \4"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

---

Quote:

---

single complicated search string:

---

neat

Thanks for all of the replies.

@Koolsid - this doesnt wqork on 11th 12th and 13th presumably because they do not fit the 1st 2nd 3rd patern.

@Westconn1 - this only works with numbers ending 1, 2, 7 and 8

@anhn - this doesnt seem to work at all but I have made some amendments.

I now have the following which works perfectly (and very efficiently) with all ordinal numbers 1st to 31st.

Code:

---

    With Selection.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "([0-9])[dhnrst]{2}"
        .Replacement.Text = "\1"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
    End With

---

Thank you for your help.