Nick
Nick

Reputation: 162

VBA - how do I stop the loop caused by the filter updating?

I want to update a normal filter when a cell within the filter is calculated.

I have a list in the range A2:A10, if it displays 1 then show the row, if it's 0 then hide the row. In the range A2:A10 I have formulas which calculates if it should be 0 or 1. I only need to update the filter if the value change and I do this with this VBA:

Private Sub Worksheet_Calculate()
    Dim RG As Range
    Set RG = Range("A2:A10")
    If Not Intersect(RG, Range("A2:A10")) Is Nothing Then
    ActiveSheet.Range("$A$1:$B$10").AutoFilter Field:=1, Criteria1:="1"
    End If
End Sub

But whenever the macro runs, excel freezes. I believe this is because a loop is created which never stops. When the filter is updated, that will cause the macro to run again. I only need it to update the filter when the value in the range is changed, but it updates the filter when the filter is updated, which will update the filter again. So, a loop is created which causes excel to freeze.

I also get a:

run-time error '-2147417848 (80010108)':

Automation error

The object invoked has disconnected from its clients.

Upvotes: 0

Views: 246

Answers (1)

Ricardo Diaz
Ricardo Diaz

Reputation: 5696

Some suggestions on your code:

  • Add EnableEvents = false so nothing else is triggered by the changes you make with the macro (and reenable them at the end of the procedure)
  • Name your variables to something meaningful e.g. targetRange instead of RG
  • Use at least a basic error handling On error Goto
  • As you have this code behind a Worksheet you can refer to that worksheet as Me instead of ActiveSheet

About the logic:

This line is redundant

If Not Intersect(targetRange, Me.Range("A2:A10")) Is Nothing Then

You are defining the range as Range("A2:A20")

Set targetRange = Me.Range("A2:A10")

I left it so you can change it to whatever you want to check


Refactored code:

Private Sub Worksheet_Calculate()

    On Error GoTo CleanFail

    ' Disable events so nothing else is triggered by the changes you make with the macro
    Application.EnableEvents = False
       
    Dim targetRange As Range
    Set targetRange = Me.Range("A2:A10")

    ' This next line doesn't make sense, you're comparing the same ranges
    If Not Intersect(targetRange, Me.Range("A2:A10")) Is Nothing Then
        Me.Range("$A$1:$B$10").AutoFilter Field:=1, Criteria1:="1"
    End If
    

CleanExit:
    ' Reenable events
    Application.EnableEvents = True
    Exit Sub
    
CleanFail:
    MsgBox "Error: " & Err.Description
    GoTo CleanExit
    
End Sub

Let me know if you have any questions.

Upvotes: 1

Related Questions