[RESOLVED] Remove Ordinal Suffix

[georgeeasten]

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!):

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.

[Siddharth Rout]

Here is one way.

Tested it with this text in the word document.

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

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

[westconn1]

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

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

[anhn]

Another way with a single complicated search string:

    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

[westconn1]

single complicated search string:

neat

[georgeeasten]

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.

    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.