Clean Up Word Headings - Array

[dj44]

Hi folks,:)

Good Friday.

I made something to clean up my heading 1, to strip some punctuation.

It makes the headings dissapear.






Sub CleanHeadingsArray()


Application.ScreenUpdating = False
Dim oWordsHeading
Dim i As Long


oWordsHeading = Array(":", ";", "0", "1", "#", "33", "XV","44","$","&","*")



With ActiveDocument.Range.Find
'.ClearFormatting
'.Replacement.ClearFormatting
.Style = ActiveDocument.Styles("Heading 1")
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False

For i = 0 To UBound(oWordsHeading)
.Text = oWordsHeading(i)
.Replacement.Text = ""
.Style = ActiveDocument.Styles("Heading 1")
.Execute Replace:=wdReplaceAll
Next
End With
Application.ScreenUpdating = True

End Sub





Any ideas welcome
Thank you

[gmaxey]

It worked fine here.


Sub CleanHeadingsArray()
Dim vChars
Dim i As Long
Application.ScreenUpdating = False
vChars = Array(":", ";", "0", "1", "#", "33", "XV", "44", "$", "&", "*")
For i = 0 To UBound(vChars)
With ActiveDocument.Range.Find
.ClearFormatting
.Replacement.ClearFormatting
.Style = ActiveDocument.Styles("Heading 1")
.Forward = True
.Wrap = wdFindContinue
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Text = vChars(i)
.Replacement.Text = ""
.Execute Replace:=wdReplaceAll
End With
Next i
Application.ScreenUpdating = True
End Sub

[dj44]

Thank you Greg,

Nicely done.

A lot more cleaner, than mine upside down :grinhalo:


Hope you have a great day!