How to count the number of times a cell changes applied to multiple cells in the same row.

Brentcan03

New Member
Joined
Feb 25, 2012
Messages
3
I want to be able to track the number of times each cell in a row is changed and then display that value in the row below the changed row. Below is how I am currently doing this however, I am not sure this solution is scalable to 100 rows. Any idea how to do this more effeciently?

I Right click my sheet tab, left click View Code and this code is in the white space:

If Target.Address = "$C$3" Then [C4].Value = 1
If Target.Address = "$D$3" Then [D4].Value = 1
If Target.Address = "$E$3" Then [E4].Value = 1
If Target.Address = "$F$3" Then [F4].Value = 1
If Target.Address = "$G$3" Then [G4].Value = 1
If Target.Address = "$H$3" Then [H4].Value = 1
If Target.Address = "$I$3" Then [I4].Value = 1
If Target.Address = "$J$3" Then [J4].Value = 1
If Target.Address = "$K$3" Then [K4].Value = 1
If Target.Address = "$L$3" Then [L4].Value = 1
If Target.Address = "$M$3" Then [M4].Value = 1
If Target.Address = "$N$3" Then [N4].Value = 1
If Target.Address = "$O$3" Then [O4].Value = 1
If Target.Address = "$P$3" Then [P4].Value = 1
If Target.Address = "$Q$3" Then [Q4].Value = 1
If Target.Address = "$R$3" Then [R4].Value = 1
If Target.Address = "$S$3" Then [S4].Value = 1
If Target.Address = "$T$3" Then [T4].Value = 1
If Target.Address = "$V$3" Then [V4].Value = 1
If Target.Address = "$W$3" Then [W4].Value = 1
If Target.Address = "$X$3" Then [X4].Value = 1
If Target.Address = "$Y$3" Then [Y4].Value = 1
If Target.Address = "$Z$3" Then [Z4].Value = 1
If Target.Address = "$AA$3" Then [AA4].Value = 1
If Target.Address = "$AB$3" Then [AB4].Value = 1
If Target.Address = "$AC$3" Then [AC4].Value = 1
If Target.Address = "$AD$3" Then [AD4].Value = 1
If Target.Address = "$AE$3" Then [AE4].Value = 1
If Target.Address = "$AF$3" Then [AF4].Value = 1
If Target.Address = "$AG$3" Then [AG4].Value = 1
If Target.Address = "$AH$3" Then [AH4].Value = 1
If Target.Address = "$AI$3" Then [AI4].Value = 1
If Target.Address = "$AJ$3" Then [AJ4].Value = 1
If Target.Address = "$AK$3" Then [AK4].Value = 1
If Target.Address = "$AL$3" Then [AL4].Value = 1
If Target.Address = "$AM$3" Then [AM4].Value = 1
If Target.Address = "$AN$3" Then [AN4].Value = 1
If Target.Address = "$AO$3" Then [AO4].Value = 1
If Target.Address = "$AP$3" Then [AP4].Value = 1
If Target.Address = "$AQ$3" Then [AQ4].Value = 1
If Target.Address = "$AR$3" Then [AR4].Value = 1
If Target.Address = "$AS$3" Then [AS4].Value = 1
If Target.Address = "$AT$3" Then [AT4].Value = 1
If Target.Address = "$C$6" Then [C7].Value = 1
If Target.Address = "$D$6" Then [D7].Value = 1
If Target.Address = "$E$6" Then [E7].Value = 1
If Target.Address = "$F$6" Then [F7].Value = 1
If Target.Address = "$G$6" Then [G7].Value = 1
If Target.Address = "$H$6" Then [H7].Value = 1
If Target.Address = "$I$6" Then [I7].Value = 1
If Target.Address = "$J$6" Then [J7].Value = 1
If Target.Address = "$K$6" Then [K7].Value = 1
If Target.Address = "$L$6" Then [L7].Value = 1
If Target.Address = "$M$6" Then [M7].Value = 1
If Target.Address = "$N$6" Then [N7].Value = 1
If Target.Address = "$O$6" Then [O7].Value = 1
If Target.Address = "$P$6" Then [P7].Value = 1
If Target.Address = "$Q$6" Then [Q7].Value = 1
If Target.Address = "$R$6" Then [R7].Value = 1
If Target.Address = "$S$6" Then [S7].Value = 1
If Target.Address = "$T$6" Then [T7].Value = 1
If Target.Address = "$V$6" Then [V7].Value = 1
If Target.Address = "$W$6" Then [W7].Value = 1
If Target.Address = "$X$6" Then [X7].Value = 1
If Target.Address = "$Y$6" Then [Y7].Value = 1
If Target.Address = "$Z$6" Then [Z7].Value = 1
If Target.Address = "$AA$6" Then [AA7].Value = 1
If Target.Address = "$AB$6" Then [AB7].Value = 1
If Target.Address = "$AC$6" Then [AC7].Value = 1
If Target.Address = "$AD$6" Then [AD7].Value = 1
If Target.Address = "$AE$6" Then [AE7].Value = 1
If Target.Address = "$AF$6" Then [AF7].Value = 1
If Target.Address = "$AG$6" Then [AG7].Value = 1
If Target.Address = "$AH$6" Then [AH7].Value = 1
If Target.Address = "$AI$6" Then [AI7].Value = 1
If Target.Address = "$AJ$6" Then [AJ7].Value = 1
If Target.Address = "$AK$6" Then [AK7].Value = 1
If Target.Address = "$AL$6" Then [AL7].Value = 1
If Target.Address = "$AM$6" Then [AM7].Value = 1
If Target.Address = "$AN$6" Then [AN7].Value = 1
If Target.Address = "$AO$6" Then [AO7].Value = 1
If Target.Address = "$AP$6" Then [AP7].Value = 1
If Target.Address = "$AQ$6" Then [AQ7].Value = 1
If Target.Address = "$AR$6" Then [AR7].Value = 1
If Target.Address = "$AS$6" Then [AS7].Value = 1
If Target.Address = "$AT$6" Then [AT7].Value = 1

End Sub

In ThisWorkBook in the VBA project window I have this code

Private Sub Workbook_Open()
[C4].Value = 0
[B4].Value = 0
[C4].Value = 0
[D4].Value = 0
[E4].Value = 0
[F4].Value = 0
[G4].Value = 0
[H4].Value = 0
[I4].Value = 0
[J4].Value = 0
[K4].Value = 0
[L4].Value = 0
[M4].Value = 0
[N4].Value = 0
[O4].Value = 0
[P4].Value = 0
[Q4].Value = 0
[R4].Value = 0
[S4].Value = 0
[T4].Value = 0
[U4].Value = 0
[V4].Value = 0
[W4].Value = 0
[X4].Value = 0
[Y4].Value = 0
[Z4].Value = 0
[AA4].Value = 0
[AB4].Value = 0
[AC4].Value = 0
[AD4].Value = 0
[AE4].Value = 0
[AF4].Value = 0
[AG4].Value = 0
[AH4].Value = 0
[AI4].Value = 0
[AJ4].Value = 0
[AK4].Value = 0
[AL4].Value = 0
[AM4].Value = 0
[AN4].Value = 0
[AO4].Value = 0
[AP4].Value = 0
[AQ4].Value = 0
[AR4].Value = 0
[AS4].Value = 0
[AT4].Value = 0
[C7].Value = 0
[B7].Value = 0
[C7].Value = 0
[D7].Value = 0
[E7].Value = 0
[F7].Value = 0
[G7].Value = 0
[H7].Value = 0
[I7].Value = 0
[J7].Value = 0
[K7].Value = 0
[L7].Value = 0
[M7].Value = 0
[N7].Value = 0
[O7].Value = 0
[P7].Value = 0
[Q7].Value = 0
[R7].Value = 0
[S7].Value = 0
[T7].Value = 0
[U7].Value = 0
[V7].Value = 0
[W7].Value = 0
[X7].Value = 0
[Y7].Value = 0
[Z7].Value = 0
[AA7].Value = 0
[AB7].Value = 0
[AC7].Value = 0
[AD7].Value = 0
[AE7].Value = 0
[AF7].Value = 0
[AG7].Value = 0
[AH7].Value = 0
[AI7].Value = 0
[AJ7].Value = 0
[AK7].Value = 0
[AL7].Value = 0
[AM7].Value = 0
[AN7].Value = 0
[AO7].Value = 0
[AP7].Value = 0
[AQ7].Value = 0
[AR7].Value = 0
[AS7].Value = 0
[AT7].Value = 0
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If [C4].Value = 1 Then [C5].Value = [C5].Value + 1
If [D4].Value = 1 Then [D5].Value = [D5].Value + 1
If [E4].Value = 1 Then [E5].Value = [E5].Value + 1
If [F4].Value = 1 Then [F5].Value = [F5].Value + 1
If [G4].Value = 1 Then [G5].Value = [G5].Value + 1
If [H4].Value = 1 Then [H5].Value = [H5].Value + 1
If [I4].Value = 1 Then [I5].Value = [I5].Value + 1
If [J4].Value = 1 Then [J5].Value = [J5].Value + 1
If [K4].Value = 1 Then [K5].Value = [K5].Value + 1
If [L4].Value = 1 Then [L5].Value = [L5].Value + 1
If [M4].Value = 1 Then [M5].Value = [M5].Value + 1
If [N4].Value = 1 Then [N5].Value = [N5].Value + 1
If [O4].Value = 1 Then [O5].Value = [O5].Value + 1
If [P4].Value = 1 Then [P5].Value = [P5].Value + 1
If [Q4].Value = 1 Then [Q5].Value = [Q5].Value + 1
If [R4].Value = 1 Then [R5].Value = [R5].Value + 1
If [S4].Value = 1 Then [S5].Value = [S5].Value + 1
If [T4].Value = 1 Then [T5].Value = [T5].Value + 1
If [U4].Value = 1 Then [U5].Value = [U5].Value + 1
If [V4].Value = 1 Then [V5].Value = [V5].Value + 1
If [W4].Value = 1 Then [W5].Value = [W5].Value + 1
If [X4].Value = 1 Then [X5].Value = [X5].Value + 1
If [Y4].Value = 1 Then [Y5].Value = [Y5].Value + 1
If [Z4].Value = 1 Then [Z5].Value = [Z5].Value + 1
If [AA4].Value = 1 Then [AA5].Value = [AA5].Value + 1
If [AA4].Value = 1 Then [AA5].Value = [AA5].Value + 1
If [AB4].Value = 1 Then [AB5].Value = [AB5].Value + 1
If [AC4].Value = 1 Then [AC5].Value = [AC5].Value + 1
If [AD4].Value = 1 Then [AD5].Value = [AD5].Value + 1
If [AE4].Value = 1 Then [AE5].Value = [AE5].Value + 1
If [AF4].Value = 1 Then [AF5].Value = [AF5].Value + 1
If [AG4].Value = 1 Then [AG5].Value = [AG5].Value + 1
If [AH4].Value = 1 Then [AH5].Value = [AH5].Value + 1
If [AI4].Value = 1 Then [AI5].Value = [AI5].Value + 1
If [AJ4].Value = 1 Then [AJ5].Value = [AJ5].Value + 1
If [AK4].Value = 1 Then [AK5].Value = [AK5].Value + 1
If [AL4].Value = 1 Then [AL5].Value = [AL5].Value + 1
If [AM4].Value = 1 Then [AM5].Value = [AM5].Value + 1
If [AN4].Value = 1 Then [AN5].Value = [AN5].Value + 1
If [AO4].Value = 1 Then [AO5].Value = [AO5].Value + 1
If [AP4].Value = 1 Then [AP5].Value = [AP5].Value + 1
If [AQ4].Value = 1 Then [AQ5].Value = [AQ5].Value + 1
If [AR4].Value = 1 Then [AR5].Value = [AR5].Value + 1
If [AS4].Value = 1 Then [AS5].Value = [AS5].Value + 1
If [AT4].Value = 1 Then [AT5].Value = [AT5].Value + 1
If [C7].Value = 1 Then [C8].Value = [C8].Value + 1
If [D7].Value = 1 Then [D8].Value = [D8].Value + 1
If [E7].Value = 1 Then [E8].Value = [E8].Value + 1
If [F7].Value = 1 Then [F8].Value = [F8].Value + 1
If [G7].Value = 1 Then [G8].Value = [G8].Value + 1
If [H7].Value = 1 Then [H8].Value = [H8].Value + 1
If [I7].Value = 1 Then [I8].Value = [I8].Value + 1
If [J7].Value = 1 Then [J8].Value = [J8].Value + 1
If [K7].Value = 1 Then [K8].Value = [K8].Value + 1
If [L7].Value = 1 Then [L8].Value = [L8].Value + 1
If [M7].Value = 1 Then [M8].Value = [M8].Value + 1
If [N7].Value = 1 Then [N8].Value = [N8].Value + 1
If [O7].Value = 1 Then [O8].Value = [O8].Value + 1
If [P7].Value = 1 Then [P8].Value = [P8].Value + 1
If [Q7].Value = 1 Then [Q8].Value = [Q8].Value + 1
If [R7].Value = 1 Then [R8].Value = [R8].Value + 1
If [S7].Value = 1 Then [S8].Value = [S8].Value + 1
If [T7].Value = 1 Then [T8].Value = [T8].Value + 1
If [U7].Value = 1 Then [U8].Value = [U8].Value + 1
If [V7].Value = 1 Then [V8].Value = [V8].Value + 1
If [W7].Value = 1 Then [W8].Value = [W8].Value + 1
If [X7].Value = 1 Then [X8].Value = [X8].Value + 1
If [Y7].Value = 1 Then [Y8].Value = [Y8].Value + 1
If [Z7].Value = 1 Then [Z8].Value = [Z8].Value + 1
If [AA7].Value = 1 Then [AA8].Value = [AA8].Value + 1
If [AA7].Value = 1 Then [AA8].Value = [AA8].Value + 1
If [AB7].Value = 1 Then [AB8].Value = [AB8].Value + 1
If [AC7].Value = 1 Then [AC8].Value = [AC8].Value + 1
If [AD7].Value = 1 Then [AD8].Value = [AD8].Value + 1
If [AE7].Value = 1 Then [AE8].Value = [AE8].Value + 1
If [AF7].Value = 1 Then [AF8].Value = [AF8].Value + 1
If [AG7].Value = 1 Then [AG8].Value = [AG8].Value + 1
If [AH7].Value = 1 Then [AH8].Value = [AH8].Value + 1
If [AI7].Value = 1 Then [AI8].Value = [AI8].Value + 1
If [AJ7].Value = 1 Then [AJ8].Value = [AJ8].Value + 1
If [AK7].Value = 1 Then [AK8].Value = [AK8].Value + 1
If [AL7].Value = 1 Then [AL8].Value = [AL8].Value + 1
If [AM7].Value = 1 Then [AM8].Value = [AM8].Value + 1
If [AN7].Value = 1 Then [AN8].Value = [AN8].Value + 1
If [AO7].Value = 1 Then [AO8].Value = [AO8].Value + 1
If [AP7].Value = 1 Then [AP8].Value = [AP8].Value + 1
If [AQ7].Value = 1 Then [AQ8].Value = [AQ8].Value + 1
If [AR7].Value = 1 Then [AR8].Value = [AR8].Value + 1
If [AS7].Value = 1 Then [AS8].Value = [AS8].Value + 1
If [AT7].Value = 1 Then [AT8].Value = [AT8].Value + 1
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)
Brentcan03,

In your first bunch of code you do not use U3 & U4 but later you do set U4 to 0.
Are you using column U?

Also, what is the last row that needs to generate a 1 in the row below when it's value is changed?
 
Last edited:
Upvote 0
Tony,

Thanks for the quick response. The omission of U was a clerical error on my part, I am using that colmn. The last row used will fluctuate based on number of Teachers being tracked on the spreadsheet at any one time. It will move anywhere from 60-80.

Thanks

Brent
 
Upvote 0
Brent,

Here is some revised code that should help.

I have assumed that the cells to be changed by the user are rows 3, 6, 9,12 etc.
In the Worksheet_BeforeClose code I refer to Sheet1. You will need to edit this to suit your sheet's name.
I have presumed to put both the count incrementing and the resetting of the indicator cell values to 0 in the before close code. Unless you have a particular reason why one should be done upon opening the file and the other upon closing then tis should be fine.
In the WBC code ther is a variable, NumTeachers which is currently set at 5 for testing purposes. This will need altering to suit. If at some point we can identify relevant criteria this can be coded to automatically adjust to the number of teachers.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = True
If Not Target.Row Mod 3 = 0 Then Exit Sub  'If row number is not a multiple of 3 do nothing
Select Case Target.Column
Case 1, 2, Is > 46    'If not valid column do nothing
Exit Sub
Case Else  'Otherwise...
Target.Offset(1, 0).Value = 1  'Row below = 1
End Select
End Sub

Code:
Sub WorkBook_BeforeClose(Cancel As Boolean)
Dim MyRange As Range
NumTeachers = 5 '***Edit 5 to be number of teachers
Set MyRange = Sheets("Sheet1").Range("C1:AT1") 'Edit sheet name to suit
Application.EnableEvents = False '*Disable the Worksheet change event code whilst doing this
For i = 1 To NumTeachers
    Set MyRange = MyRange.Offset(3, 0)
      For Each cell In MyRange
      If cell.Value = 1 Then cell.Offset(1, 0).Value = cell.Offset(1, 0).Value + 1
      cell.Value = 0
      Next cell
Next i
Application.EnableEvents = True  'Restart events*
End Sub

Let me know if that helps.
 
Upvote 0

Forum statistics

Threads
1,213,489
Messages
6,113,954
Members
448,535
Latest member
alrossman

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top