CODEWITHSUNDEEP
excelvba
S.Tri
S.Tri

Reputation: 11

VBA manual worksheet calculate for change event

I'm fairly new to VBA and looking for any advice on how to manually control the change event for the below. Column "F" has a Vlookup that returns "Fail" or "0", and rather that having each individual code to hide the row when the single cell in column F changes to 0, I found the below to work the best.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRow As Long

If Target.Column = 6 Then
'       Loop through rows 5-160
    For myRow = 5 To 160
'           Hide row in entry in column F is "0"
        Rows(myRow).Hidden = (Cells(myRow, "F") = "0")
    Next myRow
End If

End Sub

I have tried to use the below with the event change but it crashes the program and always restarts. Any suggestions would be greatly appreciated.Thanks!

Private Sub Worksheet_Calculate()
   Worksheet_Change Range("F:F")
End Sub

Upvotes: 1

Views: 1064

Answers (1)

user4039065
user4039065

Reputation:

This is my version of what you are trying to accomplish. If the values returned by the formulas in F5:F160 change, the changed values are caught by Worksheet_Calculate and only those changed values are processed by Worksheet_Change.

Caveat: This method of capturing changed values from formulas does not work well when volatile functions are in the workbook. Volatile functions include TODAY(), NOW(), OFFSET(...), etc.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("F5:F160")) Is Nothing Then
        Application.EnableEvents = False
        On Error GoTo meh
        Dim t As Range
        Debug.Print "chg: " & Intersect(Target, Range("F5:F160")).Address(0, 0)

        For Each t In Intersect(Target, Range("F5:F160"))
            't.EntireRow Hidden = CBool(LCase(t.Value2) = "fail" or t.Value2=0)
            t.EntireRow.Hidden = CBool(LCase(t.Value2) = "fail")
        Next t
    End If

meh:
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_Calculate()
    Static effs As Variant
    Dim f As Long, t As Range

    If IsEmpty(effs) Then
        effs = Range("F1:F160").Value2
        For f = 5 To 160
            If IsError(effs(f, 1)) Then effs(f, 1) = vbNullString
        Next f
    Else
        For f = 5 To 160
            If Not IsError(Cells(f, "F")) Then
                If effs(f, 1) <> Cells(f, "F").Value2 Then
                    If Not t Is Nothing Then
                        Set t = Union(t, Cells(f, "F"))
                    Else
                        Set t = Cells(f, "F")
                    End If
                    effs(f, 1) = Cells(f, "F").Value2
                End If
            End If
        Next f

        If Not t Is Nothing Then
            Debug.Print "calc: " & t.Address(0, 0)
            Worksheet_Change t
        End If
    End If
End Sub

This seems to run well on a test workbook. Additional error and looping control may be necessary in your own situation.

Upvotes: 1

Related Questions