Find and Replace Macro - A Better Way

[Tribos]

Hi

It started with hours of fruitless googling, then after a struggle I managed to record a find and replace macro to create subscripts. Finally I have come up with a working solution but IMHO the code is ugly. I'm sure there is a way to tidy it up... would love to know how.

In the meanwhile the Macro converts N2 to N2, CO2 to CO2, etc. The code is repetitive, I'm sure it's possible to put a Dim ### as Range or so... to tidy it up. Would love some feedback.



Kind regards

Steve

____________

Sub FixChemicals()
'
' FixChemicals Macro
' Macro recorded 10/8/2008 by STEVEN
'
'Nitrogen
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "N2"
        .Replacement.Text = "N2makesub"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'Oxygen
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "O2"
        .Replacement.Text = "O2makesub"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'Water
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "H2O"
        .Replacement.Text = "H2makesubO"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
'CarbonDioxide
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "CO2"
        .Replacement.Text = "CO2makesub"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = True
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute Replace:=wdReplaceAll


'Convert into subscript
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
    With Selection.Find
        .Text = "2makesub"
        .Replacement.Text = "2"
        .Forward = True
        .Wrap = wdFindContinue
        .Format = True
        .MatchCase = False
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    
    With Selection.Find.Replacement
        .Font.subscript = True
    End With
    Selection.Find.Execute Replace:=wdReplaceAll
End Sub