VBA Not Application.Intersect + Worksheet_Calculate

[bnichols]

This worked about a week ago, but it stopped for some reason. I have a checkbox and the below code is supposed to trigger when the cell N89 changes (changes via a formula). Right now, when I try and check the box, it triggers the code and unchecks it. I tried disabling the true/false enable evens and calculation manual/auto to see if it fixed it, but it didn't. Any advice is appreciated!

Private Sub Worksheet_Calculate()

Set ws = ThisWorkbook.ActiveSheet
     If ws.Name Like "Period*" Then

    ActiveWorkbook.Save
    On Error GoTo ErrorHandler
    'Err.Raise vbObjectError + 1000
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
         .EnableEvents = False

        Dim Target As Range
        Set Target = Range("N89")
        Set cboxVariance = ws.CheckBoxes("Variance Wk1")
        Set KeyCellsV = Range("N89")

       If Not Application.Intersect(KeyCellsV, Range(Target.Address)) _
       Is Nothing Then
    cboxVariance.Value = xlOff

    End If
End With
ErrorExit:
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .DisplayStatusBar = True
      .EnableEvents = True
    Exit Sub

ErrorHandler:
    MsgBox "The following Error occurred: " & Err.Description
    Resume ErrorExit

End With
End If
End Sub

 

[aaewalsh]

It looks like the code is checking the value of cell N89 and then setting the value of the checkbox "Variance Wk1" to xlOff (unchecked) if the value of cell N89 has changed. The issue you're experiencing is likely caused by the code running in an infinite loop, where the checkbox is being unchecked, which causes the Worksheet_Calculate event to trigger again, which unchecks the checkbox again, and so on. To fix this issue, you can try adding a check to see if the checkbox is already unchecked before running the code that unchecks it.

If cboxVariance.Value = xlOff Then Exit Sub
cboxVariance.Value = xlOff

This will ensure that the code only runs when the checkbox is checked and will prevent the infinite loop.

Another solution could be that the checkbox is being updated by another function, making the Worksheet_Calculate function redundant and unnecessary.

Private Sub Worksheet_Calculate()

' Assign the active sheet to a variable
Set ws = ThisWorkbook.ActiveSheet
     If ws.Name Like "Period*" Then

    ' Save the workbook
    ActiveWorkbook.Save
    On Error GoTo ErrorHandler

    ' Turn off calculation, screen updating, and enable events
    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
        .DisplayStatusBar = False
        .EnableEvents = False
    End With
    
    ' Declare variables for the target range and checkbox
    Dim Target As Range
    Set Target = Range("N89")
    Set cboxVariance = ws.CheckBoxes("Variance Wk1")
    Set KeyCellsV = Range("N89")
    
    ' Check if the target range intersects with the key cells
    If Not Application.Intersect(KeyCellsV, Range(Target.Address)) _
    Is Nothing Then
        ' Check if the checkbox is already unchecked
        If cboxVariance.Value = xlOff Then Exit Sub
        cboxVariance.Value = xlOff
    End If

ErrorExit:
    ' Turn on calculation, screen updating, and enable events
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
        .DisplayStatusBar = True
        .EnableEvents = True
        Exit Sub
    End With

ErrorHandler:
    ' Display error message
    MsgBox "The following Error occurred: " & Err.Description
    Resume ErrorExit

End If
End Sub