Mert Karakaya
Mert Karakaya

Reputation: 173

Excel freezes during execution of vba

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

Answers (3)

Mert Karakaya
Mert Karakaya

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

SierraOscar
SierraOscar

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

AnalystCave.com
AnalystCave.com

Reputation: 4984

Resolution:

Because of this line: Do Until rng Is Nothing

It probably won't stop being Nothing any time soon.

Tip for future:

  • Do try to debug line by line F8 or Shift+F8 to find issues first.
  • If you want to prevent code freezing when doing long code loops do add DoEvents at the end of each loop. This will allow you to break your code using Esc.

Upvotes: 1

Related Questions