Count when cell has changed

[Jer-XL-emy]

Hello, I bow down to the genuises that reside here.
My Question is: How can I have a cell count the number of times another cell changes.
I have a macro found on this forum that does work when I manually change the cell, but will not work when the cell changes automatically.

Here is what I have

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Column = 22 Then Target.Offset(0, -5).Value = Target.Offset(0, -5).Value + 1
If Target.Count > 1 Then Exit Sub
If Target.Column = 23 Then Target.Offset(0, -5).Text = Target.Offset(0, -5).Text + 1
End Sub
(modified for my purposes)

This is a macro written from a longtime poster here (I cannot find where I found it so I cannot give him the credit he deserves)

Again, it works when I change the cell manually, but there is a formula behind it and I need it to work when the cell changes on the surface

I am assuming it has something to do with the .value - but not sure

I thank you in advance

 

[Boller]

This might work (it's a bit "kludgy" though).

Four helper columns are required (which can be hidden) - I have assumed columns X:AA

Run this once to set up the columns:-

Sub SetUp()
[V:W].Copy [X:Y]
Range([Z1], [V65536].End(xlUp)(1, 6)).FormulaR1C1 = "=IF(RC[-4]=RC[-2],"""",1)"
[X:AA].EntireColumn.Hidden = True
End Sub

Then :-

Private Sub Worksheet_Calculate()
Dim rng As Range, cell As Range
On Error Resume Next
Set rng = [Z:AA].SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
Application.EnableEvents = False
If Not rng Is Nothing Then
    For Each cell In rng
        cell(1, -8) = cell(1, -8) + 1
    Next
End If
[X:Y] = [V:W].Value
Range([Z1], [V65536].End(xlUp)(1, 6)).FormulaR1C1 = "=IF(RC[-4]=RC[-2],"""",1)"
Application.EnableEvents = True
End Sub

 

[Jer-XL-emy]

Yup that works...Thanks boller

 

[Boller]

I noticed a possible problem with the code.
Here's a revision :-

Private Sub Worksheet_Calculate()
Dim rng As Range, cell As Range
Application.EnableEvents = False
[Z:AA].ClearContents
Range([Z1], [V65536].End(xlUp)(1, 6)).FormulaR1C1 = "=IF(RC[-4]=RC[-2],"""",1)"
On Error Resume Next
Set rng = [Z:AA].SpecialCells(xlCellTypeFormulas, 1)
On Error GoTo 0
If Not rng Is Nothing Then
    For Each cell In rng
        cell(1, -8) = cell(1, -8) + 1
    Next
End If
[X:Y] = [V:W].Value
Range([Z1], [V65536].End(xlUp)(1, 6)).FormulaR1C1 = "=IF(RC[-4]=RC[-2],"""",1)"
Application.EnableEvents = True
End Sub

 

[Jer-XL-emy]

Yes, that one works great and is easier on the processor..Thanks Boller