Re: Help me optimize VBA code

Tech-Archive recommends: Fix windows errors by optimizing your registry

---

• From: "Dave Lett" <davelett@xxxxxxxxxxxxx>
• Date: Wed, 5 Apr 2006 12:35:39 -0400

---

Hi,

Are you looking for something like the following:

Sub ReplaceIPA2()
Dim aFind
Dim aReplace
Dim iCount As Integer
aFind = Array("97", "9492", "9472", "9496", "9474", "9484", "9532", "9500",
_
"9508", "9524", "9516", "9563", "9562", "58")
aReplace = Array("593", "596", "230", "603", "601", "652", "331", "952", _
"240", "658", "643", "712", "716", "720")

For iCount = 0 To UBound(aFind)
With Selection.Find
.ClearFormatting
.Text = ChrW(aFind(iCount))
.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
With .Replacement
.ClearFormatting
.Text = ChrW(aReplace(iCount))
.Font.Color = wdColorRed
End With
.Execute Replace:=wdReplaceAll
End With
Next iCount
End Sub


HTH,
Dave

<ivanov.ivaylo@xxxxxxxxx> wrote in message
news:1144241900.699064.314080@xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx

I have docs in Word with contain IPA (International Phonetic Alphabet)
symbols used to indicate the pronumciation of the words. When I changed
the font these symbols appear incorrectly. I wrote a VBA macro that
converts the incorrect symbols to the correct VBA symbols. All symbols
that are part of the pronunciation (i.e. need to be VBA) are written in
a red font to be differentiated from the remaining symbols. These is so
because some of the red symbols coincide with non-red symbols and only
the red ones must be converted.

Help me to optimize this macro:

Sub ReplaceIPA2()

' "a" in "father"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(97)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(593)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "o" "pot"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9492)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(596)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "a" in "cat"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9472)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(230)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "e" in "bet"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9496)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(603)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "a" in "alone"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9474)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(601)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "u" in "cut"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9484)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(652)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "ng" in "sing"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9532)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(331)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "th" in "thin"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9500)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(952)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "th" in "this"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9508)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(240)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "s" in "pleasure"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9524)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(658)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' "sh" in "ship"
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9516)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(643)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' primary stress
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9563)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(712)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' secondary stress
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(9562)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(716)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

' length mark
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = ChrW(58)
.Font.Color = wdColorRed
.Replacement.Text = ChrW(720)
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Format = False
End With
Selection.Find.Execute Replace:=wdReplaceAll

End Sub

.

---

• Follow-Ups:
  • Re: Help me optimize VBA code
    • From: ivanov.ivaylo@xxxxxxxxx
  • Re: Help me optimize VBA code
    • From: Helmut Weber

• References:
  • Help me optimize VBA code
    • From: ivanov.ivaylo@xxxxxxxxx

• Prev by Date: Re: Field codes/autotext
• Next by Date: Speed up repaginating
• Previous by thread: Help me optimize VBA code
• Next by thread: Re: Help me optimize VBA code
• Index(es):
  • Date
  • Thread

---

Relevant Pages RE: Font Change in Word Macro ... .Wrap = wdFindAsk ... .Format = False ... .MatchWholeWord = False ... .Wrap = wdFindContinue ... (microsoft.public.word.vba.general) Help me optimize VBA code ... a red font to be differentiated from the remaining symbols. ... .Wrap = wdFindContinue ... .Format = False ... (microsoft.public.word.vba.general) Re: Extend Finds in search string please? ... .Wrap = wdFindContinue ... .Format = True ... .MatchWholeWord = False ... (microsoft.public.word.vba.beginners) Re: Extend Finds in search string please? ... .Wrap = wdFindContinue ... .Format = True ... .MatchWholeWord = False ... (microsoft.public.word.vba.beginners) Use of arrays and loops ... I need to write a word macro that looks up a series of web pages, ... Dim ie As InternetExplorer ... .Wrap = wdFindContinue ... (microsoft.public.word.vba.general)

---

• Windows
• Science
• Usenet

• Archive
• About
• Privacy
• Search
• Imprint

www.tech-archive.net  > Archive  > Word  > microsoft.public.word.vba.general  > 2006-04