help with a change to existing vba

[cjcass]

Hi,

Hope you can help...

I have the code below which changes the font format of a specific chosen word wherever it appears across the selected range of cells. The target word which requires a format change is determined by the word typed into cell B3. This works fine unless the target word happens to be the first word in the cell, whereupon the code re-formats all the text in the cell and not just the target word. How can I prevent this happening?

Any help greatly appreciated!

Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer


On Error Resume Next
Application.DisplayAlerts = False
SearchText = Range("B3").Value
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
TotalLen = Len(SearchText)
StartPos = InStr(UCase(cl), UCase(SearchText))
TestPos = 0
Do While StartPos > TestPos
With cl.Characters(StartPos, TotalLen).Font
.FontStyle = "Bold"
.ColorIndex = 5
End With
EndPos = StartPos + TotalLen
TestPos = TestPos + EndPos
StartPos = InStr(TestPos, cl, SearchText, vbTextCompare)
Loop
Next cl
End If

 

[steve the fish]

It looked ok to me so ive just run it and it doesn't display that behaviour on my machine.

 

[cjcass]

Try it a few times with the same selection. For me it happens after a couple of executions

 

[cjcass]

Hi,
This problem persists, can anyone help me with it?
Many thanks

 

[AkaTrouble]

Hi,
This problem persists, can anyone help me with it?
Many thanks

don't know if this will help as i don't get same issue trying code

just before the end of loop i would set SearchText = ""

thus clearing previous value also setting it empty for next time the code is run

may have no effect just a thought

 

[cjcass]

exactly where does this go in the code please?

 

[AkaTrouble]

exactly where does this go in the code please?

anywhere after you have used the current value stored example below

Dim cl As Range
Dim SearchText As String
Dim StartPos As Integer
Dim EndPos As Integer
Dim TestPos As Integer
Dim TotalLen As Integer


On Error Resume Next
Application.DisplayAlerts = False
SearchText = Range("B3").Value
On Error GoTo 0
Application.DisplayAlerts = True
If SearchText = "" Then
Exit Sub
Else
For Each cl In Selection
  TotalLen = Len(SearchText)
  StartPos = InStr(UCase(cl), UCase(SearchText))
  TestPos = 0
  Do While StartPos > TestPos
    With cl.Characters(StartPos, TotalLen).Font
      .FontStyle = "Bold"
      .ColorIndex = 5
    End With
    EndPos = StartPos + TotalLen
    TestPos = TestPos + EndPos
    StartPos = InStr(TestPos, cl, SearchText, vbTextCompare)
  Loop
Next cl
SearchText = ""
End If

edit got it in wrong place first paste

 

[AkaTrouble]

on reading up it seems this is not needed so sorry for wasting your time

the result of my search was this info

"There is no need to set any local variable to Nothing at the end of a sub, because the memory manager does this automatically.

If you call a sub the (VBA-) stack is increased automatically, any local variable is place inside this memory structure and the stack shrinks automatically if the sub ends and any local variable is removed.

Only global object variables in normal modules should be set to Nothing to release the object from memory. Forget anything else."

 

[cjcass]

Hi, tried that didn't have any affect unfortunately

 

[cjcass]

Thanks for your time though I appreciate it.
Any further ideas out there?