CODEWITHSUNDEEP
vbaexcel
user1923052
user1923052

Reputation: 67

How do I fire an Excel VBA Macro whenever a cell value is updated?

I have a Sub that I would like to run whenever cells are updated to contain a certain value.

Right now I'm using code like the following:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  If Target.Cells.Count = 1 Then
    If Target.Value = XYZ Then
      my_sub a, b, c
    End If
  End If
End Sub

The issue right now is that the macro only fires when I edit these cells directly, not when changes in other cells force these cells to change.

Additionally, these cells are not well defined, so I can not hard code "when A5 changes", for example. I need this to fire every time any cell in my workbook is updated (manually or through formulas) to meet my condition.

Upvotes: 0

Views: 1312

Answers (3)

brettdj
brettdj

Reputation: 55672

  1. Add your cells to be tracked to a named formula (named range). I used rngValue
  2. Use a static variable to track how many times the value you want to track occurs in this range
  3. Use the Calculate event to check if the number of occurences changes

code

Private Sub Worksheet_Calculate()
Dim StrIn As String
Static lngCnt As Long
Dim lngCnt2 As Long

StrIn = "apples"

lngCnt2 = Application.WorksheetFunction.CountIf(Range("rngValue"), StrIn)
If lngCnt2 <> lngCnt Then
    lngCnt = lngCnt2
    Call mysub
End If

End Sub

Upvotes: 1

Miqi180
Miqi180

Reputation: 1691

Provided your target is only a single cell with a formula that needs to be monitored, this will work:

Option Explicit

Dim tarVal As Variant

Private Sub Worksheet_Activate()

    tarVal = ActiveSheet.Range("A1").Value ' change range parameter to the address of the target formula

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim tempVal As Variant

    tempVal = ActiveSheet.Range("A1").Value

    If tempVal <> tarVal Then
        tarVal = tempVal

        ' your code here

        MsgBox "The value of A1 has changed" ' for testing purposes only, delete later
    End If

End Sub

Edit

The following code works for an entire range of cells, but only if automatic calculation is turned on. In case the monitored cells are non-contiguous, just use union statements when defining the target range. (The target range is A1:A10 in this example). This is under the assumption that only one of formulas in the target range can change its value at a time. If multiple target formulas can do that, then remove Exit for in the Worksheet_Change subroutine.

Option Explicit

Dim tarCellCount As Long
Dim tarRng As Range
Dim tarVals As Variant

Private Sub Worksheet_Activate()

    Dim i As Long
    Dim cll As Range

    Set tarRng = ActiveSheet.Range("A1:A10") ' change range parameter to the addresses of the target formulas

    tarCellCount = tarRng.Cells.count
    ReDim tarVals(1 To tarCellCount) As Variant

    For Each cll In tarRng
        i = i + 1
        tarVals(i) = cll.Value
    Next cll

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim changeBool As Boolean
    Dim i As Long
    Dim cll As Range
    Dim tempVal As Variant

    For Each cll In tarRng
        tempVal = cll.Value
        i = i + 1

        If tempVal <> tarVals(i) Then
            tarVals(i) = tempVal
            changeBool = True
            Exit For
        End If
    Next cll

    If changeBool Then

      ' your code here

        MsgBox "The value of one of the cells in the target range has changed" ' for testing purposes only, delete later
    End If

End Sub

Upvotes: 2

velbl&#250;d
velbl&#250;d

Reputation: 363

Target is a range that CAN contain more cells. This code should work for you.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
  For Each cell In Target.Cells
    If cell.Value = XYZ Then
      my_sub a, b, c
    End If
  Next cell
End Sub

Edit: I see that you want to fire that also when formula is updated defined value. It can be slow if you will check every cell, but really depends on the size of your file. Here is some code to give you idea how to do it.

Private Sub Workbook_SheetCalculate(ByVal sh As Object)
    For Each cell In  sh.Cells.SpecialCells(xlCellTypeFormulas).Cells
        If cell.Value = XYZ Then
           my_sub a, b, c
        End If
    Next cell
End Sub

Upvotes: -1

Related Questions