Ugly code!

[ABrown]

I have inherited this rather lengthy macro which changes straight quotes to smart quotes and removes any bold from such quotes. It is really lengthy and I think this can be done in a much neater fashion, but I am not sure even where to start!! Has anyone had to invent something similar they could share with me. This is the code inherited in my current template.....

Sub SmartQuotes()
'
' SmartQuotes Macro
' Converts straight and bold quotes to smart regular quotes and dashes to n dashes
'
Selection.TypeText Text:="vggvx"
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = """"
.Replacement.Text = """"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "'"
.Replacement.Text = "'"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Font.Bold = True
Selection.Find.Replacement.ClearFormatting
Selection.Find.Replacement.Font.Bold = False
With Selection.Find
.Text = """"
.Replacement.Text = """"
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "-"
.Replacement.Text = "^="
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
With Selection.Find
.Text = "vggvx"
.Replacement.Text = "^="
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
End Sub

Many thanks - Annette:rotlaugh:

[OTWarrior]

try this:

Sub SmartQuotes()
Dim TextVar
Dim RepTextVar
On Error GoTo err1
'
' SmartQuotes Macro
' Converts straight and bold quotes to smart regular quotes and dashes to n dashes
'
Selection.TypeText Text:="vggvx"
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

TextVar = Array("'", """", "-", "vggvx")
RepTextVart = Array("'", """", "^=", "^=")

For i = LBound(TextVar) To UBound(TextVar)
With Selection.Find
.Text = TextVar(i)
.Replacement.Text = RepTextVar(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Next i

Exit Sub
err1:
MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error"

End Sub

[ABrown]

Thanks for very quick response - I have tried running the code, but I just get the error message and nothing happens - Am I doing something wrong - I have tried it with and without autoformat options selected and get the same error! Thanks. Annette

[OTWarrior]

Sorry, I was typing too quickly and misspelt one of the variables....

Sub SmartQuotes()
Dim TextVar
Dim RepTextVar
'
' SmartQuotes Macro
' Converts straight and bold quotes to smart regular quotes and dashes to n dashes
'
Selection.TypeText Text:="vggvx"
Selection.HomeKey Unit:=wdStory
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting

TextVar = Array("'", """", "-", "vggvx")
RepTextVar = Array("'", """", "^=", "^=")

For i = LBound(TextVar) To UBound(TextVar)
With Selection.Find
.Text = TextVar(i)
.Replacement.Text = RepTextVar(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.Execute
Selection.Delete Unit:=wdCharacter, Count:=1
Next i

Exit Sub

End Sub
I actually tested it this time, and it seems to work :)

If you ever need to run mutiple tests like this, you can use the array system as above, or "select case" statements. I just figured an array would be quicker and easier for this example, especially as you can quickly modify the parameters by adding values to each array.