Track how many times a cell changes-CodePudding

Given this spreadsheet

I am trying to track how many times a disk gets checked out. This the VBA I converted to check Rows instead of Columns. I copied this code from one of robinCTS posts and changed it. The problem I am seeing, when a value in cell B3 get changed, Cell B8 gets 1 added to it (Correct). If I change a value in cell D13, again cell D8 is updated (InCorrect, it should be cell D18). It is in the proper column, just the wrong row.

'============================================================================================
' Module     : <The appropriate sheet module>
' Version    : 1.0
' Part       : 1 of 1
' References : N/A
' Source     : https://stackoverflow.com/a/47405528/1961728
'============================================================================================
Option Explicit

Private Sub Worksheet_Change _
            ( _
                       ByVal Target As Range _
            )

  Const s_CheckRow As String = "3:3,13:13"
  Const s_CountRow As String = "8:8,18,18"

  If Intersect(Target, Range(s_CheckRow)) Is Nothing Then Exit Sub

  Dim rngCell As Range
  For Each rngCell In Intersect(Target, Range(s_CheckRow))
    With Range(s_CountRow).Cells(rngCell.Column)
      .Value2 = IIf(.Value2 <> vbNullString, .Value2   1, IIf(rngCell.Value2 <> vbNullString, 1, vbNullString))
    End With
  Next rngCell

End Sub

So what I am doing wrong?

CodePudding user response：

Instead of Const s_CountRow As String = "8:8,18,18" (typo there?) I'd use a fixed offset from each changed cell:

Private Sub Worksheet_Change(ByVal Target As Range)

    Const RNG_CHECK As String = "3:3,13:13"
    Const ROW_OFFSET As Long = 5
    Dim rng As Range, c As Range
    
    Set rng = Application.Intersect(Target, Range(RNG_CHECK))
    If rng Is Nothing Then Exit Sub
    For Each c In rng.Cells
        If Len(c.Value) > 0 Then
            c.Offset(ROW_OFFSET).Value = c.Offset(ROW_OFFSET).Value   1
        End If
    Next c

End Sub