A Second Set of Eyes - Cannot Spot the Error

[PosIIx]

Hello,

I'm using the code below to change the color of certain words to red and apply a double underline. It was working well for a while; no more. I must have done something but I cant sort out what. The macro runs with no errors, but does not apply the formatting.

The Sub:

Sub Test()
' from Doug Robbins, Word MVP, Microsoft forums, Feb 2015, based on another macro written by Graham Mayor, Aug 2010
Dim oDoc As Document, oChanges1 As Document
Dim oTable1 As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim x As Long
Dim sFname1 As String

'Change the path in the line below to reflect the name and path of the table document
sFname1 = "C:\Users\bcg\Documents\MacroTable\B.docx"
Set oDoc = ActiveDocument
Set oChanges1 = Documents.Open(FileName:=sFname1, Visible:=False)


Set oTable1 = oChanges1.Tables(1)


For x = 1 To oTable1.Rows.Count
Set oRng = oDoc.Range
Set rFindText = oTable1.Cell(i, 1).Range
rFindText.End = rFindText.End - 1
Selection.HomeKey wdStory
With oRng.Find
.Style = "Body Text"
.Font.Underline = wdUnderlineNone
.Font.Color = wdColorAutomatic
.Font.Size = 11
End With
With oRng.Find.Replacement
.Font.Underline = wdUnderlineDouble
.Font.Color = wdColorRed
End With
With oRng.Find
.MatchWildcards = True
.Text = rFindText.Text
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next x
oChanges1.Close wdDoNotSaveChanges
End Sub

B.docx has only a table that looks like this:



of


pursuant


ed by


has been




The Body Text format is automatic color, size 11 Calibri font

The idea was to create a macro that would change the formatting of the words phrases in the table, in the document.

Can you see why this isn't working? Thanks so much for your time.

Brent

[gmaxey]

Since you don't declare all the variables you use (like I think I have advised you to do) if you would have debugged your code would have immediately realize that "i" was not declared. That might have helped you.

Assumes "B.docx" is in the same folder as the document you are processing.



Sub Test()
' from Doug Robbins, Word MVP, Microsoft forums, Feb 2015, based on another macro written by Graham Mayor, Aug 2010
Dim oDoc As Document, oChanges1 As Document
Dim oTbl As Table
Dim oRng As Range
Dim strFind As String
Dim lngIndex As Long
Set oDoc = ActiveDocument
Set oChanges1 = Documents.Open(FileName:=ThisDocument.Path & "\B.docx", Visible:=False)
Set oTbl = oChanges1.Tables(1)
For lngIndex = 1 To oChanges1.Tables(1).Rows.Count
Set oRng = oDoc.Range
strFind = Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2)
Set oRng = oDoc.Range
With oRng.Find
.Style = "Body Text"
.Text = strFind
With .Replacement
.Font.Underline = wdUnderlineDouble
.Font.Color = wdColorRed
.Text = strFind
End With
.MatchWildcards = True
.Forward = True
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
Next lngIndex
oChanges1.Close wdDoNotSaveChanges
End Sub

[PosIIx]

Hi Greg,

Thanks for your patients. I'm really green at this. Your suggestion worked perfectly ofcourse.

Can I ask you one more question? Is it possible to use a table for a number of words to avoid in the code you previously provided me? Here is that code:

'A basic Word macro code by Gregory K. Maxey
Dim iRngErr As Range
Dim iDoc As Document
Dim iCol As New Collection
Set iDoc = ActiveDocument
For Each iRngErr In iDoc.SpellingErrors
With iRngErr
If .Characters.First.Previous = Chr(34) Or .Characters.First.Previous = ChrW(8220) And _
.Characters.Last.Next = Chr(34) Or .Characters.Last.Next = ChrW(8221) Or _
.Characters.First.Next.Italic = True Or .Characters.First.Next.Underline = True Or _
.Text = "ONCA" Or .Text = "FCA" Or .Text = "BCSC" Or .Text = "BCCA" Then
iCol.Add iRngErr, iRngErr
On Error Resume Next
End If
End With
Next iRngErr
For Each iRngErr In iDoc.SpellingErrors
On Error Resume Next
iCol.Add iRngErr, iRngErr
If Err.Number = 0 And Selection.Font.Underline = wdUnderlineNone Then
With iRngErr.Font
.Size = 16
.Underline = wdUnderlineDouble
.ColorIndex = wdGreen
End With
iCol.Remove (iCol.Count)
Else
iRngErr.SpellingChecked = True
End If
Next iRngErr
lbl_Exit:
'

How do I get spellcheck to ignore a number of words in a table in the code above?


For each thing you teach me, I try to teach myself two more - its a quite tough to get your bearings with this. I appreciate your help.

Thanks again Greg.

Brent

[gmaxey]

Brett,

I really don't know what you want to do.

Please if you are going to post any code then put it in code tags (the # on the toolbar). If you are going to post my code (code with my name associated with it), then certainly don't butcher it up with your variable names:

Dim iRngErr As Range
Dim iDoc As Document
Dim iCol As New Collection

[PosIIx]

Hi Greg,

Sorry if I offended, no intention there just really not sure what I'm doing I won't mess with your variable names moving forward.

And I'm sorry for not being clearer. I'll try to rephrase. You can see that I added a number of acronyms to the following portion of the code above:


If .Characters.First.Previous = Chr(34) Or .Characters.First.Previous = ChrW(8220) And _
.Characters.Last.Next = Chr(34) Or .Characters.Last.Next = ChrW(8221) Or _
.Characters.First.Next.Italic = True Or .Characters.First.Next.Underline = True Or _
.Text = "ONCA" Or .Text = "FCA" Or .Text = "BCSC" Or .Text = "BCCA" Then


I was hoping to have those (ONCA, FCA, BCSC, BCCA), and any others I dream up, to a table similar to what I did with my first question in this thread. Is there a way to set up a table in another document and have your algorithm add the contents of the table to the iCol collection, which the spellcheck then ignores in the same way it does with the terms in brackets within parentheses?

Thanks for bearing with me. Sorry if this is frustrating. I really appreciate your help.

Brent

[gmaxey]

My skin is thicker than that. I am not offended. I just don't see your reasoning for changing my oDoc (o = Object, Doc Document) to iDoc (what does "i" mean?) and then posting it as through that was mine ;-). Then it waste time to format your code when you don't put it in code brackets.


Sub Fixed()
'A basic Word macro code by Gregory K. Maxey
Dim oErr As Range
Dim oDoc As Document
Dim colExcl As New Collection
Set oDoc = ActiveDocument
Dim oTbl As Table, lngIndex As Long
Set oTbl = Documents.Open(ThisDocument.Path & "\Excludes.docm").Tables(1)
On Error Resume Next
For lngIndex = 1 To oTbl.Rows.Count
colExcl.Add Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2), _
Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2)
Next lngIndex
oTbl.Parent.Close wdDoNotSaveChanges
For Each oErr In oDoc.SpellingErrors
With oErr
If .Characters.First.Previous = Chr(34) Or .Characters.First.Previous = ChrW(8220) And _
.Characters.Last.Next = Chr(34) Or .Characters.Last.Next = ChrW(8221) Or _
.Characters.First.Next.Italic = True Or .Characters.First.Next.Underline = True Then
colExcl.Add oErr, oErr
End If
End With
Next oErr
For Each oErr In oDoc.SpellingErrors
colExcl.Add oErr, oErr
If Err.Number = 0 And Selection.Font.Underline = wdUnderlineNone Then
With oErr.Font
.Size = 16
.Underline = wdUnderlineDouble
.ColorIndex = wdGreen
End With
colExcl.Remove (colExcl.Count)
Else
oErr.SpellingChecked = True
End If
Next oErr
lbl_Exit:
Exit Sub
End Sub

[PosIIx]

Hi Greg,

Thanks so much for your response. Sorry for the delay, I haven't had a great deal of time to look into this recently.

The macro doesn't seem to be ignoring the values I've entered into the table. It is the second table in the reference document.

I tried to incorporate your code into my macro. It does a number of things and there are other variables defined above, so if I've changed your variable names that is why. Also, the reference document is not in the same folder as the main document, so I altered to account for that.

Can you spot the problem with the following code:


'A basic Word macro code by Gregory K. Maxey Dim iRngErr As Range
Dim iDoc As Document
Dim iCol As New Collection
Set iDoc = ActiveDocument
Dim sFname2 As String
sFname2 = "C:\Users\bcg\Documents\MacroTable\B.docx"
Dim oChanges2 As Document
Set oChanges2 = Documents.Open(FileName:=sFname1, Visible:=False)
Dim oTbl As Table, lngIndex As Long
Set oTbl = oChanges2.Tables(2)
On Error Resume Next
For lngIndex = 1 To oTbl.Rows.Count
colExcl.Add Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2), _
Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2)
iCol.Add lngIndex, lngIndex
Next lngIndex
oTbl.Parent.Close wdDoNotSaveChanges
For Each iRngErr In iDoc.SpellingErrors
With iRngErr
If .Characters.First.Previous = Chr(34) Or .Characters.First.Previous = ChrW(8220) And _
.Characters.Last.Next = Chr(34) Or .Characters.Last.Next = ChrW(8221) Or _
.Characters.First.Next.Italic = True Or .Characters.First.Next.Underline = True Or _
.Style = "Quote 4" Then
iCol.Add iRngErr, iRngErr
On Error Resume Next
End If
End With
Next iRngErr
For Each iRngErr In iDoc.SpellingErrors
On Error Resume Next
iCol.Add iRngErr, iRngErr
If Err.Number = 0 And Selection.Font.Underline = wdUnderlineNone Then
With iRngErr
.Font.Size = 16
.Font.Underline = wdUnderlineDouble
.Font.ColorIndex = wdGreen
End With
iCol.Remove (iCol.Count)
Else
iRngErr.SpellingChecked = True
End If
Next iRngErr
lbl_Exit:

Thanks as always for your assistance.

Brent

[gmaxey]

Brent,

Once again, you have associated my name with code that you foul up! I am not offended. Just annoyed.

If you would add the Option Explicit statement to your code module then (as I have advised repeatedly) you would recognize that you are putting the excludes in a collection that was never declared. Thereafter you are ignoring it.

[PosIIx]

Hi Greg,

Sorry to have annoyed you.


Brent,

If you would add the Option Explicit statement to your code module then (as I have advised repeatedly) you would recognize that you are putting the excludes in a collection that was never declared. Thereafter you are ignoring it.

At the risk of ignoring you further, can you explain what you mean above? Did I not declare the collection with: Dim iCol As New Collection?

Thanks as always Greg.

Brent

[gmaxey]

Brent,

Shouldn't that have been at the risk of "annoying you further?"

You are trying to use two collections in your code 1) colExcl which you never declared and 2) iCol which has no relationship whatsoever with the list of words in the table except what row they are in.

Stet through your code line by line using the F8 key. Show the locals window and watch how your variables are used and the collection populated.

[PosIIx]

Hi Greg,

Yes, you're right, annoying not ignoring. I think I've corrected the problems you mentioned, but it still isn't working. What follows is my whole macro. Please don't be annoyed by the abhorrent state of this code, I'm trying earnestly I assure you.


Sub Tighten()'
' from Doug Robbins, Word MVP, Microsoft forums, Feb 2015, based on another macro written by Graham Mayor, Aug 2010
ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions
Dim oChanges As Document, oDoc As Document, oChanges1 As Document
Dim oTable As Table
Dim oTable1 As Table
Dim oRng As Range
Dim rFindText As Range, rReplacement As Range
Dim i As Long
Dim x As Long
Dim sFname As String
Dim sFname1 As String
'Change the path in the line below to reflect the name and path of the table document
sFname = "C:\Users\bcg\Documents\MacroTable\A.docx"
sFname1 = "C:\Users\bcg\Documents\MacroTable\B.docx"
Set oDoc = ActiveDocument
Set oChanges = Documents.Open(FileName:=sFname, Visible:=False)
Set oChanges1 = Documents.Open(FileName:=sFname1, Visible:=False)
Set oTable = oChanges.Tables(1)
Set oTable1 = oChanges1.Tables(1)
For i = 1 To oTable.Rows.Count
Set oRng = oDoc.Range
Set rFindText = oTable.Cell(i, 1).Range
rFindText.End = rFindText.End - 1
Set rReplacement = oTable.Cell(i, 2).Range
rReplacement.End = rReplacement.End - 1
Selection.HomeKey wdStory
With oRng.Find
.Font.Size = 11
.Font.Italic = wdItalicNone
.Style = "Body Text"
.Style = "Normal"
.Style = "List Paragraph"
End With
'
With oRng.Find
.MatchWildcards = True
.Text = rFindText.Text
.Replacement.Text = rReplacement.Text
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next i
oChanges.Close wdDoNotSaveChanges
ActiveDocument.TrackRevisions = Not ActiveDocument.TrackRevisions
'
For x = 1 To oTable1.Rows.Count
Set oRng = oDoc.Range
Set rFindText = oTable1.Cell(x, 1).Range
rFindText.End = rFindText.End - 1
Selection.HomeKey wdStory
With oRng.Find
.Font.Underline = wdUnderlineNone
.Font.Color = wdColorAutomatic
.Font.Size = 11
End With
'
With oRng.Find
.MatchWildcards = True
.Text = rFindText.Text
.Replacement.Text = ""
.Replacement.Font.Underline = wdUnderlineDouble
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Next x
oChanges1.Close wdDoNotSaveChanges
'
'
'A basic Word macro code by Gregory K. Maxey
Dim iRngErr As Range
Dim iDoc As Document
Dim colExcl As New Collection
Dim sFname2 As String
Dim oChanges2 As Document
Dim oTbl As Table, lngIndex As Long
Set iDoc = ActiveDocument
Set oChanges2 = Documents.Open(FileName:=sFname1, Visible:=False)
Set oTbl = oChanges2.Tables(2)
sFname2 = "C:\Users\bcg\Documents\MacroTable\B.docx"
On Error Resume Next

For lngIndex = 1 To oTbl.Rows.Count
colExcl.Add Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2), _
Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2)
Next lngIndex
oTbl.Parent.Close wdDoNotSaveChanges
For Each iRngErr In iDoc.SpellingErrors
With iRngErr
If .Characters.First.Previous = Chr(34) Or .Characters.First.Previous = ChrW(8220) And _
.Characters.Last.Next = Chr(34) Or .Characters.Last.Next = ChrW(8221) Or _
.Characters.First.Next.Italic = True Or .Characters.First.Next.Underline = True Or _
.Style = "Quote 4" Then
colExcl.Add iRngErr, iRngErr
On Error Resume Next
End If
End With
Next iRngErr

For Each iRngErr In iDoc.SpellingErrors
On Error Resume Next
colExcl.Add iRngErr, iRngErr
If Err.Number = 0 And Selection.Font.Underline = wdUnderlineNone Then
With iRngErr
.Font.Size = 16
.Font.Underline = wdUnderlineDouble
.Font.ColorIndex = wdGreen
End With
colExcl.Remove (colExcl.Count)
Else
iRngErr.SpellingChecked = True
End If
Next iRngErr
lbl_Exit:
'
Exit Sub
End Sub

The part we're discussing is the last part, which I've updated so that all iCol references have been replaced with colExcl. It didn't seem to affect the outcome. Also, when I F8 through my code, it doesn't let me get to the part we're discussing.

Is there a better way than what I've done to get a macro to do more than one thing?

Thanks for your perseverance. I am learning if that is any consolation.

Brent

[PosIIx]

Hi Greg,

Please disregard the above. Here is your code, unadulterated save for my specifying the file location:


Sub Fixed()
Dim oErr As Range
Dim oDoc As Document
Dim colExcl As New Collection
Set oDoc = ActiveDocument
Dim oTbl As Table, lngIndex As Long
Dim sFname As String
sFname = "C:\Users\bcg\Documents\MacroTable\C.docx"
Set oTbl = Documents.Open(sFname).Tables(1)
For lngIndex = 1 To oTbl.Rows.Count
colExcl.Add Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2), _
Left(oTbl.Cell(lngIndex, 1).Range.Text, Len(oTbl.Cell(lngIndex, 1).Range.Text) - 2)
Next lngIndex
oTbl.Parent.Close wdDoNotSaveChanges
For Each oErr In oDoc.SpellingErrors
With oErr
If .Characters.First.Previous = Chr(34) Or .Characters.First.Previous = ChrW(8220) And _
.Characters.Last.Next = Chr(34) Or .Characters.Last.Next = ChrW(8221) Or _
.Characters.First.Next.Italic = True Or .Characters.First.Next.Underline = True Or .Style = "Quote 4" Then
colExcl.Add oErr, oErr
End If
End With
Next oErr
For Each oErr In oDoc.SpellingErrors
colExcl.Add oErr, oErr
If Err.Number = 0 And Selection.Font.Underline = wdUnderlineNone Then
With oErr.Font
.Size = 16
.Underline = wdUnderlineDouble
.ColorIndex = wdGreen
End With
colExcl.Remove (colExcl.Count)
Else
oErr.SpellingChecked = True
End If
Next oErr
lbl_Exit:
Exit Sub
End Sub

It does not appear to be avoiding the text I've set out in the table, though it does avoid words in quotes. As I F8 through the code, I see it adding each of table's elements to colExcl. It does skip the words in quotes and any misspelled words that Word has not found and augmented with the squiggly red underline. But once Word has so augmented, the algorithm changes misspelled words in the table to size 16 green, regardless whether they are in the ignore table.

Is there anything I can do to the above to make this work?

Thanks Greg, you're a lifesaver.

Brent

[gmaxey]

Take the last part out of your current macro and create a new macro using just it. Get it to work (it does) and then put it back. At that point you need to figure out why your code doesn't run to the point where it should begin to run last part.

I'm not going to create a user name, folders, and files like yours just to test your code.

I have asked you three times not to post (or associate) my name with code that you are going to retool until you break it and use your peculiar brand of variable naming convention. Again, what does "i" suppose to signify in "iDoc" ?

[PosIIx]

Hi Greg,

iDoc is arbitrary, I chose it because I'd already Dim'd oDoc above. I will not post your code with your name associated with it any time I change it.

In a follow-up post to my last message (just above your last response), I did exactly as you've just suggested, except that I tested your code in isolation as opposed to mine. It doesn't appear to be working for the words in the table, though it does for those in quotes. As I F8 through the code, I see it adding each of table's elements to colExcl. In the end it does skip the words in quotes and any misspelled words that Word has not found and augmented with the squiggly red underline. But once Word has so augmented, the algorithm changes misspelled words in the table to size 16 green, regardless whether they are in the ignore table.

Thanks for bearing with me on this.

[gmaxey]

Unzip the attached to your desktop.

[PosIIx]

Hi Greg,

Thank you for providing that. I don't really know what to say, I just ran your example unaltered and all three of acronyms jumped to size 16 green. Is it possible that some setting in Word could be interfering with the macro?

Thanks for bearing with me on this.

Brent

[gmaxey]

Brent,

I suppose that anything is possible. Add the line show below and step through using F8:


For Each oErr In oDoc.SpellingErrors
On Error Resume Next 'Added
colExcl.Add oErr, oErr
MsgBox Err.Number & " " & Err.Description 'Add this line. It should return 457 - This key is already associated with an element of this collection for DDD and FFC.
If Err.Number = 0 And Selection.Font.Underline = wdUnderlineNone Then

[PosIIx]

Hi Greg,

You are a lifesaver. Thank you, I now have it working. If you don't mind, I only have one more issue to fill out my understanding. When working with With statements such as the following:


With oRng.Find
.Font.Underline = wdUnderlineNone
.Font.Color = wdColorAutomatic
.Font.Size = 11
End With

... is there a way to have it ignore certain Styles? When I try to input .Style <> "Quote 4" I get an error. Alternatively, is it possible to have it target more than one style? When i input


With oRng.Find
.Font.Underline = wdUnderlineNone
.Font.Color = wdColorAutomatic
.Font.Size = 11
.Style = "Normal"
.Style = "Body Text"
End With

it seems to only target the last style. When I try


With oRng.Find
.Font.Underline = wdUnderlineNone
.Font.Color = wdColorAutomatic
.Font.Size = 11
.Style = "Normal" Or .Style = "Body Text"

End With

I get a type mismatch. I've tried to look for an explanation online but I've come up dry so far. Is there a trick to making this work?

Thank you Yoda.

Brent

[gmaxey]

First, "I now have it working." It was working here when I posted it You said, earlier that it didn't work for you when ran unaltered. Are you sure about that? What did you do or undo to get it to work?

[gmaxey]

No, you can't do something like that with the .style parameter. You might so this:


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Word.Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "time"
.Style
While .Execute
Select Case oRng.Style
Case "Normal", "Body Text" 'etc.
'Do or don't do something
oRng.Text = "Some text"
Case Else
'Do or don't do something
End Select
Wend
End With
lbl_Exit:
Exit Sub
End Sub

[PosIIx]

Hi Greg,

Sorry, next time I'll include the changes I made. The code worked, save for the issue that for some reason it didn't run when I placed the doc in the same folder as the list, I had to make it source the folder specifically. The second issue wasn't the code, but how you set out the information in your List table . You included the acronym only, whereas I was using (for example): " ONCA ". It seems the spaces before and after were throwing it off.

Thanks for bearing with me on this. Must be annoying to deal with newbs all the time. I hate being one. You're a good guy.

Brent

[gmaxey]

You're welcome. What little that I know was not bestowed on me. I had to run the same gauntlet that you are now running.

[PosIIx]

Hi Greg,

I tried the code you suggested previously, but (and I'm sure you're not supprised), it still appears to apply the edits in Quote 4 Style. Here is the code (I've Dim'd the table information earlier in the macro, assume the rFindText reference to the table works fine.)


For x = 1 To oTable1.Rows.Count Set oRng = oDoc.Range
Set rFindText = oTable1.Cell(x, 1).Range
rFindText.End = rFindText.End - 1
Selection.HomeKey wdStory
With oRng.Find
.Font.Underline = wdUnderlineNone
.Font.Color = wdColorAutomatic
.Font.Size = 11
End With
With oRng.Find
.Text = rFindText.Text
While .Execute
Select Case oRng.Style
Case "Quote 4"
Case Else
.MatchWildcards = True
.Replacement.Text = ""
.Replacement.Font.Underline = wdUnderlineDouble
.Replacement.Font.Color = wdColorRed
.Forward = True
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End Select
Wend
End With

Thanks as always Greg, fun gauntlet, this.

Brent

[gmaxey]

Brent,

You really just need to figure this out. If you post incomplete code as you did above then you assume that somebody else wants to spend their time adding or rewriting it so is at least runs. I'm not one of those bodies.

If I have the following in document.

This is a test sentence with Normal style.
This is a test sentence with Body Text style.

... and run this code


Sub ScratchMacro()
'A basic Word macro coded by Greg Maxey
Dim oRng As Range
Set oRng = ActiveDocument.Range
With oRng.Find
.Text = "test"
While .Execute
Select Case oRng.Style
Case Is = "Normal" ' Skip
Case Else
MsgBox "Don't skip"
End Select
Wend
End With
lbl_Exit:
Exit Sub
End Sub


The instance found with Normal style is skipped. Step though yours, add some messages boxes like Msgbox oRng.Sytle, tinker until you figure it out.