Find and Replace Macro

Tribos · #1 10-08-2008, 03:22 AM

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

____________

Code:

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

Thread Tools
Show Printable Version Email this Page
Display Modes
Linear Mode Switch to Hybrid Mode Switch to Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Macro Issue	Basanth	Excel	1	12-05-2008 08:07 PM
Macro Writing	cweachter	Excel	0	08-09-2008 08:30 PM
**FIND OUT WHO WAS BCC(BLIND CARBON COPIED) ON YOUR EMAILS??	sharpescalade	Outlook	1	11-30-2006 08:07 AM
How Do I Replace Nulls With Zeros?	deekadelic	Excel	1	08-11-2006 09:52 PM
Find and Replace box flies off screen!	M Skabialka	Word	2	06-06-2006 10:05 AM