How to count number of times a cell is changed in Excel?

How to count the number of times a cell is changed in Excel?

To count the number of times a specified cell is changed in Excel, the VBA codes provided in this article can help.

Count the number of times a cell is changed with VBA code

Count the number of times a cell is changed with VBA code

The following VBA codes can help you to count the number of times a specified cell is changed in Excel.

1. In worksheet that contains one or more cells for which you need to calculate the total change, right-click the sheet tab, and then click View Code from the context menu. See screenshot:

2. In the opening Microsoft Visual Basic for Applications window, copy and paste one of the following VBA codes into the Code window according to your needs.

VBA code 1: Track changes to one cell only

Dim xCount As Integer
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim xRg As Range, xCell As Range
    On Error Resume Next
    If Target = Range("B9") Then
        xCount = xCount + 1
        Range("C9").Value = xCount                                     
    End If
    Application.EnableEvents = False
    Set xRg = Application.Intersect(Target.Dependents, Me.Range("B9"))
    If Not xRg Is Nothing Then
        xCount = xCount + 1
        Range("C9").Value = xCount
    End If
    Application.EnableEvents = True
End Sub

Note: In the code, B9 is the cell you need to count its changes, and C9 is the cell to populate the counting result. Please change them as you need.

VBA code 2: Track changes to multiple cells in a column

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub

Note: In this line "Set xRRg = xCell.Offset(0, 1)", the number 1 represents the number of columns to offset to the right of the starting reference (here the starting reference is column B, and the count you want to return is in column C which locates next to column B). If you need to output the results in column S, change the number 1 to 10.

From now on, when cell B9 or any cell in the range B9:B1000 changes, the total number of changes will be superimposed and automatically filled into the specified cell.

The Best Office Productivity Tools

Kutools for Excel Solves Most of Your Problems, and Increases Your Productivity by 80%

Reuse: Quickly insert complex formulas, charts and anything that you have used before; Encrypt Cells with password; Create Mailing List and send emails...
Super Formula Bar (easily edit multiple lines of text and formula); Reading Layout (easily read and edit large numbers of cells); Paste to Filtered Range...
Merge Cells/Rows/Columns without losing Data; Split Cells Content; Combine Duplicate Rows/Columns... Prevent Duplicate Cells; Compare Ranges...
Select Duplicate or Unique Rows; Select Blank Rows (all cells are empty); Super Find and Fuzzy Find in Many Workbooks; Random Select...
Exact Copy Multiple Cells without changing formula reference; Auto Create References to Multiple Sheets; Insert Bullets, Check Boxes and more...
Extract Text, Add Text, Remove by Position, Remove Space; Create and Print Paging Subtotals; Convert Between Cells Content and Comments...
Super Filter (save and apply filter schemes to other sheets); Advanced Sort by month/week/day, frequency and more; Special Filter by bold, italic...
Combine Workbooks and WorkSheets; Merge Tables based on key columns; Split Data into Multiple Sheets; Batch Convert xls, xlsx and PDF...
More than 300 powerful features. Supports Office/Excel 2007-2019 and 365. Supports all languages. Easy deploying in your enterprise or organization. Full features 30-day free trial. 60-day money back guarantee.

Read More... Free Download... Purchase...

Office Tab Brings Tabbed interface to Office, and Make Your Work Much Easier

Enable tabbed editing and reading in Word, Excel, PowerPoint, Publisher, Access, Visio and Project.
Open and create multiple documents in new tabs of the same window, rather than in new windows.
Increases your productivity by 50%, and reduces hundreds of mouse clicks for you every day!

Read More... Free Download... Purchase...

Comments (20)

No ratings yet. Be the first to rate!

Jan

about 4 years ago

#24429

This comment was minimized by the moderator on the site

Thank you very much ! This works great.

But how do you get the same function/rule to work for a range of cells, along an entire column, for example?

I have a list of my business' contacts on different rows, with their contact details in different columns, and I want a add a column that registers and counts the number of times a given cell along each row is changed. The code you gave works great, but only for one cell at a time !

I'm new to VBA, so I would greatly appreciate your support.

I tried adding a range of cells into the code, so instead of "B9" and "C9", as given in the example above, I played around with variations like "B:B", "C:C", or "B9:B1000" and "C9:C1000", without any success.

Thanks in advance,

crystal Jan

about 4 years ago

#24430

This comment was minimized by the moderator on the site

Hi Jan,
Please try the below VBA code. Hope it can help. Thanks for your comment.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("B9:B1000")
Set xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
For xFNum = 1 To xSRg.count
If Target = xSRg.Item(xFNum) Then
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Next xFNum
Application.EnableEvents = True
End Sub

Report

Jonathan crystal

about 4 years ago

#24431

This comment was minimized by the moderator on the site

Hi Crystal,

This is brilliant, on my matrix I have used this on one of the columns but I have struggled to duplicate this across multiple columns. Do you have a solution?

Thanks in Advance

Tom Cappelletti Jonathan

about 3 years ago

#24432

This comment was minimized by the moderator on the site

Could you provide the entire code set? I'm assuming Crystal's code gets integrated with other code? Thanks

RedDragon crystal

about 2 years ago

#24433

This comment was minimized by the moderator on the site

Hi crystal,

I am having an issue with the code. If the cell for example, if I enter

B9 as "Apple" then it increments C9 by 1
B10 as "Ball" then it increments C10 by 1
However, if I enter
B11 as "Apple" again then C9 will be incremented by 1, and not C11

It seems like it increments the row with the 1st occurrence of the value and not the actual edited row.

Is there a way to just increment the cell in the same row and not a previous row?

Thanks.

Kevin

about 4 years ago

#24473

This comment was minimized by the moderator on the site

Did you figure this out. I too am interested in this for checking multiple cells. Haven’t tried it yet.

Report

crystal Kevin

about 4 years ago

#24474

This comment was minimized by the moderator on the site

Hi Kevin,

The following code can help you solving the problem. Thanks for your comment.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("B9:B1000")
Set xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
For xFNum = 1 To xSRg.count
If Target = xSRg.Item(xFNum) Then
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Next xFNum
Application.EnableEvents = True
End Sub

Report

FELIX MARIÑO crystal

about 6 months ago

#37991

This comment was minimized by the moderator on the site

Gracias de antemano por el aporte, muy útil, sin embargo, quisiera pedir su ayuda a fin de reiniciar el contador a cero cuando sea necesario, es decir, luego de contar las veces que se modificó la celda, quisiera llevarla a cero y volver a comenzar. podrás ayudarme. Gracias!

Report

Shiju

about 3 years ago

#28511

This comment was minimized by the moderator on the site

Hello All,

The solution as provided under "Count Number Of Times A Cell Is Changed With VBA Code" is good if we are only tracking changes to ONE CELL. Please suggest, what modifications are needed, if the tracking is to be done for multiple cells. In case of multiple cells, the incremental counter should appear next to the cell for which the change in value is being tracked.

Report

Shiju Shiju

about 3 years ago

#28512

This comment was minimized by the moderator on the site

Looking forward for help and assistance to have a specific VBA code, which can be applied to multiple cells in one worksheet.

crystal Shiju

about 3 years ago

#28513

This comment was minimized by the moderator on the site

Hi Shiju,
Please try the below VBA code. Thanks for commenting.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("B9:B1000")
Set xRRg = Range("C9:C1000")

Application.EnableEvents = False
On Error Resume Next
For xFNum = 1 To xSRg.count
If Target = xSRg.Item(xFNum) Then
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Next xFNum
Application.EnableEvents = True
End Sub

Report

JediTrader

about 3 years ago

#29313

This comment was minimized by the moderator on the site

Team,

When I tried using :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("B9:B1000")
Set xRRg = Range("C9:C1000")

carefully changing the Range and Target cells vis a vis P2:P200 and X2:X200 respectively, I dont the change-count in X Column despite myself trying to change cells across multiple rows across P2:P200.

Any help would be greatly appreciated.

Regards
JT

Report

Mason

about 3 years ago

#30206

This comment was minimized by the moderator on the site

Can anyone help me achieve the coding for Counting the time a cell has been changed to "Revalidate" and can that be applied down the entrieity of a column.

FELIX MARIÑO

about 6 months ago

#37992

This comment was minimized by the moderator on the site

Quisiera que me ayudaran a reiniciar el contador a cero cuando lo requiera, es decir, la celda c9 llevarla a cero y comenzar a contar b9 nuevamente.

Report

crystal FELIX MARIÑO

about 6 months ago

#38135

This comment was minimized by the moderator on the site

Hi FELIX MARIÑO,
Please add the following code after the code provided in this post. When you need to reset the cell, click on any words in the code, and then press the F5 key to run it.

Sub CleaRCount()
'Updated by Extendoffice 20220527
    xCount = 0
    Range("c9") = 0
End Sub

Report

Gadjus

about 2 months ago

#40032

This comment was minimized by the moderator on the site

Hi Crystal

I am having the same issue as RedDragon. I am trying to track date changes, for example when an agent sends a case to their manager they manually enter a date- this can happen more than once On a case so I am trying to use this code to show how many times each case has been sent to a manager. My issues are:

1) If multiple cases are sent to managers in one day, the counter increases only on the first instance of that date, not next to the rows in question.
2) Every time I exit the sheet, reopen it, and amend a date, the counter resets to "1"- how would I get this to carry over and not reset when the sheet is reopened?

Any help is greatly appreciated and thank you so much for what you have done so far.

Gadjus

crystal Gadjus

about 2 months ago

#40110

This comment was minimized by the moderator on the site

Hi Gadjus,
Sorry for the inconvinience. The following VBA code can do you a favor. Please give it a try.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220916
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("B9:B1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 1)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub

Report

I try

about 2 months ago

#40143

This comment was minimized by the moderator on the site

I try the code below and it works, but I'm using it to track changes on dates, since some dates are the same everytime I change a date that is the same to other on the colum it count again.
I try the latest code but it does nothing when I try it. THANKS FOR THIS GREAT CODE!

Private Sub Worksheet_Change(ByVal Target As Range)
Dim xRg As Range, xCell As Range
Dim xSRg, xRRg As Range
Dim xFNum As Long

Set xSRg = Range("I3:I1000")
Set xRRg = Range("S3:S1000")

Application.EnableEvents = False
On Error Resume Next
For xFNum = 1 To xSRg.Count
If Target = xSRg.Item(xFNum) Then
xRRg.Item(xFNum).Value = xRRg.Item(xFNum).Value + 1
Application.EnableEvents = True
Exit Sub
End If
Next xFNum
Application.EnableEvents = True
End Sub
Sub CleaRCount()
'Updated by Extendoffice 20220527
xCount = 0
Range("S3") = 0
End Sub

crystal I try

about 2 months ago

#40152

This comment was minimized by the moderator on the site

Hi,
The following VBA code can do you a favor. Please give it a try.
Note: In this line "Set xRRg = xCell.Offset(0, 10)", the number "10” represents the number of columns to offset to the right of the starting reference (here the starting reference is column I, and the count you want to return is in column S).

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 20220919
    Dim xSRg As Range
    Dim xRRg As Range
    
    Set xSRg = Range("I3:I1000")
    Set xCell = Intersect(xSRg, Target)
    If xCell Is Nothing Then Exit Sub
    
    
    Application.EnableEvents = False
    On Error Resume Next
    Set xCell = xCell.Range("A1")
    Set xRRg = xCell.Offset(0, 10)
    
    xRRg.Value = xRRg.Value + 1

    Application.EnableEvents = True
End Sub

Report