How to run multiple macros on multiple cell change events in a single worksheet by calling multiple macro functions

E-realm Services 0
Viewed 43

I have a worksheet and I want to call multiple subs on multiple cell change events and cell.

In this worksheet, Range("K3") and Range("K32") are formula cells and I want to call calculation() for Range("K3") and calculation1() for Range("K32").

Please guide. Thanks

Private Sub Worksheet_Calculate()
Static MyOldVal
Static MyOldVal1
If Range("K3").Value <> MyOldVal Then
Call calculation

Else
If Cells(32, 11).Value <> MyOldVal1 Then Call calculation1

MyOldVal = Range("K3").Value
MyOldVal1 = Range("K32").Value

End If
End Sub

Private Sub calculation()
Cells(4, 10) = (Cells(11, 8) + Cells(16, 8) + Cells(28, 7) + (351 * Cells(25, 3))) / 0.9 / 0.7 * 1.2
Cells(5, 10) = (Cells(11, 8) + Cells(16, 8) + Cells(28, 7) + (351 * Cells(25, 3))) / 0.7 / 0.7 * 1.2
End Sub

Private Sub calculation1()
Cells(33, 10) = (Cells(40, 8) + Cells(45, 8) + Cells(57, 7) + (351 * Cells(54, 3))) / 0.9 / 0.7 * 1.2
Cells(34, 10) = (Cells(40, 8) + Cells(45, 8) + Cells(57, 7) + (351 * Cells(54, 3))) / 0.7 / 0.7 * 1.2
End Sub
vba excel
1 Answers

You can do it like this for example:

Private Sub Worksheet_Calculate()
    Static dict As Object   'stored cell addresses and associated cell values
    Dim arrRanges, addr, v
    
    arrRanges = Array("K3", "K32") 'the cells to be monitored

    If dict Is Nothing Then        'first call?  Set up ranges and values
        Set dict = CreateObject("scripting.dictionary")
        For Each addr In arrRanges
            dict(addr) = Me.Range(addr).Value 'initial values
        Next addr
    Else              'not the first call: compare old vs. new values
        On Error Goto haveError
        Application.EnableEvents = False 'disable events
        For Each addr In arrRanges
            v = Me.Range(addr).Value
            If dict(addr) <> v Then      'value has changed ?
                Debug.Print addr, "old:" & dict(addr), "new:" & v
                Select Case addr         'which cell has changed?
                    Case "K3": calculation
                    Case "K32": calculation1
                End Select
                dict(addr) = v           'store new value?
            End If
        Next addr
    End If
haveError:
    Application.EnableEvents = True 're-enable events

End Sub

EDIT: here's a version using a hidden sheet

Private Sub Worksheet_Calculate()
    Dim arrRanges, addr, v, wsStore As Worksheet, cStore As Range, vOld
    
    Set wsStore = ThisWorkbook.Sheets("Store") 'hidden sheet
    arrRanges = Array("K3", "K32") 'the cells to be monitored
    
    On Error GoTo haveError
    Application.EnableEvents = False 'disable events
    For Each addr In arrRanges
        v = Me.Range(addr).Value
        Set cStore = wsStore.Range(addr)
        vOld = cStore.Value
        If v <> vOld Then 'value has changed ?
            Debug.Print addr, "old:" & vOld, "new:" & v
            Select Case addr         'which cell has changed?
                Case "K3": Calculation
                Case "K32": calculation1
            End Select
            cStore.Value = v        'store new value
        End If
    Next addr
    
haveError:
    Application.EnableEvents = True 're-enable events
End Sub
useryB020
Related