Reputation: 173
This find and highlight vba is run when I click the button on a user form, even though it highlights the first instance, excel freezes and does not respond for a long time. Does not show any bug or such.
Private Sub changebutton_tp_Click()
Dim sheet As Worksheet
Dim table_list_obj As ListObject
Dim table_obj_row As ListRow
Set sheet = Sheets("TermGUI")
Dim rng As Range
Set rng = sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
LookIn:xlValues, lookat:=xlWhole)
If rng Is Nothing Then
MsgBox ("Term Not Found")
ElseIf IsEmpty(rng) Then
MsgBox ("Term Not Found")
ElseIf rng = "" Then
MsgBox ("Term Not Found")
Else
With sheet.UsedRange
If Not rng Is Nothing Then
Do Until rng Is Nothing
sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Activate
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Loop
End If
End With
Set rng = Nothing
MsgBox ("Term Found and Highlighted")
End If
End Sub
OK, I have identified the infinite loop, however what I want to do is to find all the terms that match the inquiry and highlight them. Without the loop it just does for one instance.
Upvotes: 1
Views: 1562
Reputation: 173
Private Sub changebutton_tp_Click()
Dim sheet As Worksheet
Dim table_list_obj As ListObject
Dim table_obj_row As ListRow
Set sheet = Sheets("TermGUI")
Dim cll As Range
Dim rng As Range
Set rng = sheet.Cells.Find(What:=TermPage.wordfound_tp.Value, LookIn:=xlValues, lookat:=xlWhole)
If rng Is Nothing Then
MsgBox ("Term Not Found")
ElseIf IsEmpty(rng) Then
MsgBox ("Term Not Found")
ElseIf rng = "" Then
MsgBox ("Term Not Found")
Else
With sheet.UsedRange
For Each cll In Worksheets("TermGUI").Range("A1", "A100").Cells
sheet.Cells.Find(What:=TermPage.wordfound_tp.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Activate
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Next
DoEvents
End With
MsgBox ("Term Found and Highlighted")
End If
End Sub
Upvotes: 1
Reputation: 17647
Do Until rng Is Nothing '// <~~ stop condition here will never be met
sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False).Activate
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Loop
The object rng
never becomes Nothing
during your loop - and so this code will loop infinitely.
Perhaps something like this would be better:
Do Until rng Is Nothing
Set rng = Nothing
Set rng = sheet.Cells.Find(What:=TermPage.wordfound_tp.Value,_
LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
If Not rng Is Nothing Then
With rng.Interior
.ColorIndex = 6
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If
DoEvents '// <~~ IMPORTANT if you want to be able to break the loop manually.
Loop
Upvotes: 3
Reputation: 4984
Because of this line:
Do Until rng Is Nothing
It probably won't stop being Nothing
any time soon.
DoEvents
at the end of each loop. This will allow you to break your code using Esc.Upvotes: 1