Count the number of times a cell is changed for multiple cells

I have a column in my spreadsheet G that contains a date for when a project is due to complete. I need to track the number of times the value for that cell changes to basically track the number of times we push the completion date. I have a hidden column AA that represents "Times Changed". I need to figure out how to increment that everytime the cell is changed. I need to take into consideration however changing the date but making a mistake and changing it back. For example I change the date for row 10 but meant to change row 11's date so I change row 10 back to the original date. If the code is not written to execute at the right time the times changed counter would jump two for essentially a non-event.
This solution is not perfect, but it's a start. You'll need two columns (Column AA and AB) and a Worksheet Calculate Event. It will track how often the date increases. If the date decreases (as in putting it back to where it was), the value is subtracted by one. 

Column AA can still be your counter. Column AB will hold a copy of the date in the corresponding cells in Column G.

Now put this code in the vb editor for the worksheet that you are working with.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 7 Then
        If Target.Value > Target.Offset(0, 21).Value Then
            Target.Offset(0, 20).Value = Target.Offset(0, 20).Value + 1
        ElseIf Target.Value < Target.Offset(0, 21).Value Then
            Target.Offset(0, 20).Value = Target.Offset(0, 20).Value - 1
        End If
        Target.Offset(0, 21).Value = Target.Value
    End If
End Sub


Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

This works to a degree. However, it breaks when I type in a date but meant another date. In that instance I'm still incremented by two.

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

I can build in some exceptions that will allow you to either reset the ticker or force it to decrement by 1. You can also manually edit the counter. Try this. It will allow you to enter a zero to reset the ticker, or enter -1 to subtract 1 from the count.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Column = 7 Then
        If Target.Value = 0 Then
            Target.Offset(0, 21).ClearContents
            Target.Offset(0, 20).ClearContents
        ElseIf Target.Value = -1 Then
            Target.Offset(0, 20).Value = Target.Offset(0, 20).Value - 1
            Target.Offset(0, 21).Value = Target.Value
        ElseIf Target.Value > Target.Offset(0, 21).Value Then
            Target.Offset(0, 20).Value = Target.Offset(0, 20).Value + 1
            Target.Offset(0, 21).Value = Target.Value
        ElseIf Target.Value < Target.Offset(0, 21).Value Then
            Target.Offset(0, 20).Value = Target.Offset(0, 20).Value - 1
            Target.Offset(0, 21).Value = Target.Value
        End If
    End If
End Sub


 

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

What is the revised code supposed to do differently?

 

I get that i could manually manipulate the counter but ideally when this is working the counter would be invisible to someone using the spreadsheet. They will just update the date and if they make a mistake entering the date they won't know why the counter is off.

 

If there a way to do this so that it only updates the counter after the worksheet is saved or closed?

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

Yes. In fact that would be better. If you don't need to know the count until after the dates have changed and the workbook has been closed. 

First you'll need to copy all of the dates from Column G to Column AB. You'll only have to do this the first time. Then when the workbook is closed it will check each of the dates Column G with the corresponding date in Column AA. If they are different in any way, the ticker will be incremented by 1. 

Put this code in the Workbook module in VB Editor. This kind of event should probably have some error handling since the workbook closing depends on the successful running of this code. In this case, you'll get an error message if anything goes wrong and you'll have to click OK on the message to close the workbook. (Change "Sheet1" to whatever your worksheet name is.)

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim MyWorksheet As Worksheet
    Dim Cell As Range
    
    Set MyWorksheet = ThisWorkbook.Worksheets("Sheet1")
    
    For Each Cell In MyWorksheet.Range("G2:G" & MyWorksheet.Range("G" & Rows.Count).End(xlUp).Row)
        If Cell.Value <> Cell.Offset(0, 21).Value Then
            Cell.Offset(0, 20).Value = Cell.Offset(0, 20).Value + 1
        End If
    Next Cell
        
End Sub

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

OK, so I think we're almost there. The problem now is that AB is never changing to collect the new date so whether I physically change the date in G or not once it's changed it's always registering an unmatched value because AB is never updated with the new date.

 

I tried to add a line to make the date in AB update but it's not working so I assume my syntax is wrong.

 

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Dim MyWorksheet As Worksheet
    Dim Cell As Range
   
    Set MyWorksheet = ThisWorkbook.Worksheets("Sheet1")
   
    For Each Cell In MyWorksheet.Range("G2:G" & MyWorksheet.Range("G" & Rows.Count).End(xlUp).Row)
        If Cell.Value <> Cell.Offset(0, 21).Value Then
            Cell.Offset(0, 20).Value = Cell.Offset(0, 20).Value + 1
            Cell.Offset(0, 21).Value = Cell.Value
        End If
    Next Cell
       
End Sub

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

I'm also thinking it might work too if it changed on deactivate that way if I change from the current worksheet to the worksheet with the charts tracking the dates it would update. I couldn't figure out how to apply your code though to the deactivate.

Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

If you want the code to run only when you activate the worksheet that has the charts, you would put the code in THAT worksheeet activate event. If you want the code to run whenever you leave that sheet, you would put it in the deactivate event of the worksheet that has the dates in it. The body of the code above will work inside a worksheet deactivate event, like this:

Private Sub Worksheet_Deactivate()
    Dim MyWorksheet As Worksheet
    Dim Cell As Range
    
    Set MyWorksheet = ThisWorkbook.Worksheets("Sheet1")
    
    For Each Cell In MyWorksheet.Range("G2:G" & MyWorksheet.Range("G" & Rows.Count).End(xlUp).Row)
        If Cell.Value <> Cell.Offset(0, 21).Value Then
            Cell.Offset(0, 20).Value = Cell.Offset(0, 20).Value + 1
            Cell.Offset(0, 21).Value = Cell.Value
        End If
    Next Cell

End Sub


Was this reply helpful?

Sorry this didn't help.

Great! Thanks for your feedback.

How satisfied are you with this reply?

Thanks for your feedback, it helps us improve the site.

How satisfied are you with this reply?

Thanks for your feedback.

 
 

Question Info


Last updated March 23, 2024 Views 2,913 Applies to: