VBA trigger macro on cell value change

前端 未结 4 1896
青春惊慌失措
青春惊慌失措 2020-12-17 05:07

This should be simple. When the value of a cell changes I want to trigger some VBA code. The cell (D3) is a calculation from two other cells =B3*C3. I have atte

相关标签:
4条回答
  • 2020-12-17 05:23

    Or try

    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim numdependences As Integer
    On Error Resume Next
    HasDependents = Target.Dependents.Count
    If Err = 0 Then
        If InStr(Target.Dependents.Address, "$D$3") <> 0 Then
            MsgBox "change"
        End If
    End If
    On Error GoTo 0
    End Sub
    

    You need the error control in case you change a cell that has not dependents.

    0 讨论(0)
  • 2020-12-17 05:26

    Could you try something like this? Change the formula to =D3AlertOnChange(B3*C3).

    Private D3OldVal As Variant
    
    Public Function D3AlertOnChange(val)
        If val <> D3OldVal Then MsgBox "Value changed!"
        D3OldVal = val
        D3AlertOnChange = val
    End Function
    
    0 讨论(0)
  • 2020-12-17 05:28

    try this:

     Sub Worksheet_Change(ByVal Target As Range)
    
        If Not Intersect(Target, Target.Worksheet.Range("B1")) Is Nothing Then
    
          Call macro
    
        End If
    
     End Sub
    

    looks for a change in value of cell B1, then executes "macro"

    0 讨论(0)
  • 2020-12-17 05:33

    If you are only looking at if the Worksheet_Change then it will count a change for anything entered even if it is the same as the previous value. To overcome this I use a Public variable to capture the starting value and compare it.

    This is my code to do this. It also allows you omit parts of the worksheet or you can use it to evaluate every cell in the worksheet.

    Place this code in the Worksheet.

    Public TargetVal As String 'This is the value of a cell when it is selected
    
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then 'If more then one cell is selected do not save TargetVal. CountLarge is used to protect from overflow if all cells are selected.
        GoTo EXITNOW
    Else
        TargetVal = Target 'This sets the value of the TargetVal variable when a cell is selected
    End If
    EXITNOW:
    End Sub
    
     Sub Worksheet_Change(ByVal Target As Range)
    'When a cell is modified this will evaluate if the value in the cell value has changed.
    'For example if a cell is entered and enter is pressed the value is still evaluated
    'We don't want to count it as a change if the value hasn't actually changed
    
    Dim ColumnNumber As Integer
    Dim RowNumber As Integer
    Dim ColumnLetter As String
    
    '---------------------
    'GET CURRENT CELL INFO
    '---------------------
        ColumnNumber = Target.Column
        RowNumber = Target.Row
        ColumnLetter = Split(Target.Address, "$")(1)
    
    '---------------------
    'DEFINE NO ACTION PARAMETERS
    '   IF CELL CHANGED IS IN NO ACTION RANGE, EXIT CODE NOW FOR PERFORMANCE IMPROVEMENT OR TO NOT TAKE ACTION
    '---------------------
        If ColumnNumber <> 4 Then 'This would exempt anything not in Column 4
            GoTo EXITNOW
        ElseIf RowNumber <> 3 Then 'This would exempt anything not in Row 3
            GoTo EXITNOW
        'Add Attional ElseIf statements as needed
        'ElseIf ColumnNumber > 25 Then
            'GoTo EXITNOW
        End If
    
    '---------------------
    'EVALUATE IF CELL VALUE HAS CHANGED
    '---------------------
    Debug.Print "---------------------------------------------------------"
    Debug.Print "Cell: " & ColumnLetter & RowNumber & " Starting Value: " & TargetVal & " | New Value: " & Target
    
        If Target = TargetVal Then
            Debug.Print " No Change"
            'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF NOT CHANGED
        Else
            Debug.Print " Cell Value has Changed"
            'CALL MACRO, FUNCTION, or ADD CODE HERE TO DO SOMETHING IF CHANGED
        End If
    Debug.Print "---------------------------------------------------------"
    
    EXITNOW:
     End Sub
    
    0 讨论(0)
提交回复
热议问题