macro freezing - too many words?

Hi labmanager

Idea : I put the words in a sheet and I will make a loop ;-)

Try this code

Sub HighLight()
  Dim WS As Worksheet, c As Range
  Dim FindWord() As String
  Dim MyStart As Long, MyLength As Long
  ReDim FindWord(1 To 946)
  ' I put the words in a sheet and I will make a loop ;-)
  FindWord(1) = "feel"  'change to your preference
  FindWord(2) = "felt"
  FindWord(3) = "think "
  FindWord(4) = "thought"
  FindWord(5) = "ador"
  FindWord(6) = "afraid"
  FindWord(7) = "alright"
  FindWord(8) = "amazed"
  FindWord(9) = "anger"
  FindWord(10) = "appreciate"
  FindWord(11) = "argued"
  FindWord(12) = "awarded"
  FindWord(13) = "awkward"
  FindWord(14) = "bad"
  **up to 946**
  ' Make manual calculation if they are formula
  Application.Calculation = xlCalculationManual
  ' Disable events
  Application.EnableEvents = False
  ' Hidde application
  Application.Visible = False
  
  For Each WS In Worksheets
    For i = 1 To 946
      With WS.Cells
        Set c = .Find(FindWord(i), LookIn:=xlValues)
        If Not c Is Nothing Then
          firstAddress = c.Address
          Do
            MyStart = InStr(UCase(c.Value), UCase(FindWord(i)))
            MyLength = Len(FindWord(i))
            With c.Characters(Start:=MyStart, Length:=MyLength).Font
              .Size = 13
              .Color = -16776961
            End With
            'c.Interior.ColorIndex = 35 'now green, change to your preference
            Set c = .FindNext(c)
          Loop While Not c Is Nothing And c.Address <> firstAddress
        End If
      End With
    Next
  Next
  ' Show application
  Application.Visible = True
  ' Make automatic calculation
  Application.Calculation = xlCalculationAutomatic
  ' Enable events
  Application.EnableEvents = True
End Sub

A+

I have made the changes. Why can't I see the hidden response?

Originally Posted by HaHoBe

Hi, labmanager,

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here



(This thread should receive no further responses until this moderation request is fulfilled, as per Forum Rule 7)

Ciao,
Holger

I tried this, but unfortunately the program kept freezing and refused to run.

try this,
Hidden until the change

i've made the change, but i still can't see this response.

Sub HighLight()
Dim WS As Worksheet, c As Range
Dim FindWord() As String
Dim MyStart As Long, MyLength As Long
ReDim FindWord(1 To 946)

FindWord(1) = "feel" 'change to your preference
FindWord(2) = "felt"
FindWord(3) = "think "
FindWord(4) = "thought"
FindWord(5) = "ador"
FindWord(6) = "afraid"
FindWord(7) = "alright"
FindWord(8) = "amazed"
FindWord(9) = "anger"
FindWord(10) = "appreciate"
FindWord(11) = "argued"
FindWord(12) = "awarded"
FindWord(13) = "awkward"
FindWord(14) = "bad"
**up to 946**

For Each WS In Worksheets
For i = 1 To 946
With WS.Cells
Set c = .Find(FindWord(i), LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
Do
MyStart = InStr(UCase(c.Value), UCase(FindWord(i)))
MyLength = Len(FindWord(i))
With c.Characters(Start:=MyStart, Length:=MyLength).Font
.Size = 13
.Color = -16776961
End With
'c.Interior.ColorIndex = 35 'now green, change to your preference
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Next
Next

End Sub