Code modification - Log Cell colour change

[Drawleeh]

Hello, I have found some code on this very forum (Capturing cell color change in VBA) that logs when cell colour is changed on a separate worksheet. How do I adjust that same code so instead of prompting for every single cell it would only prompt once and record the row number instead of cell. Address?

Class module code as follows - labelled C_CellColorChange

Option Explicit
Private WithEvents cmb As Office.CommandBars
Private bCancel As Boolean
Private bAllCellsCounted As Boolean
Private vCellCurColor() As Variant
Private vCellPrevColor() As Variant
Private sCellAddrss() As String
Private sVisbRngAddr As String
Private i As Long
Private oSh As Worksheet
Private oCell As Range

Public Sub ApplyToSheet(Sh As Worksheet)
    Set oSh = Sh
End Sub

Public Sub StartWatching()
    Set cmb = Application.CommandBars
End Sub

Private Sub Class_Initialize()
    bAllCellsCounted = False
End Sub


Private Sub cmb_OnUpdate()

    If Not ActiveSheet Is oSh Then Exit Sub
    bCancel = False
    i = -1
VisibleRngChanged:
    If sVisbRngAddr <> ActiveWindow.VisibleRange.Address _
        And sVisbRngAddr <> "" Then
        Erase sCellAddrss
        Erase vCellCurColor
        Erase vCellPrevColor
        sVisbRngAddr = ""
        bAllCellsCounted = False
        GoTo VisibleRngChanged
    End If
    On Error Resume Next
        For Each oCell In ActiveWindow.VisibleRange.Cells
            ReDim Preserve sCellAddrss(i + 1)
            ReDim Preserve vCellCurColor(i + 1)
            sCellAddrss(i + 1) = oCell.Address
            vCellCurColor(i + 1) = oCell.Interior.Color
            If vCellPrevColor(i + 1) <> vCellCurColor(i + 1) Then
                If bAllCellsCounted = True Then
                    oCell.Interior.Color = vCellPrevColor(i + 1)
                    CallByName ThisWorkbook, _
                    "CellColorChanged", VbMethod, oCell, _
                    oCell.Interior.Color, vCellCurColor(i + 1), bCancel
                    If Not bCancel Then
                        oCell.Interior.Color = vCellCurColor(i + 1)
                        vCellPrevColor(i + 1) = vCellCurColor(i + 1)
                    Else
                        oCell.Interior.Color = vCellPrevColor(i + 1)
                        vCellCurColor(i + 1) = vCellPrevColor(i + 1)
                    End If
                    bCancel = False
                End If
            End If
                i = i + 1
            If i + 1 >= ActiveWindow.VisibleRange.Cells.Count Then
                bAllCellsCounted = True
                ReDim Preserve vCellPrevColor(UBound(vCellCurColor))
                vCellPrevColor = vCellCurColor
            End If
            vCellPrevColor(i + 1) = vCellCurColor(i + 1)
        Next
    On Error GoTo 0
        sVisbRngAddr = ActiveWindow.VisibleRange.Address

End Sub

And the workbook change event as this:

Option Explicit
Private oCellColorMonitor As C_CellColorChange

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call StopWatching
End Sub

Private Sub Workbook_Open()
    Call StartWatching
End Sub

Public Sub CellColorChanged(Cell As Range, PrevColor As Variant, NewColor As Variant, Cancel As Boolean)
    
    Const MSG1 As String = "Complete Job?"
    
    If MsgBox(MSG1 & vbNewLine, vbQuestion + vbYesNo) _
    = vbNo Then
        Cancel = True
    Else
        With Sheets("Log")
            .Cells(1, 1).End(xlDown).Offset(1) = Format(Date, "dd/mm/yyyy")
            .Cells(1, 2).End(xlDown).Offset(1) = Environ("Username")
        End With
    End If

End Sub


Private Sub StartWatching()
    Set oCellColorMonitor = New C_CellColorChange
    oCellColorMonitor.ApplyToSheet Sheets(1)
    oCellColorMonitor.StartWatching
End Sub

Private Sub StopWatching()
    Set oCellColorMonitor = Nothing
End Sub

 

[Drawleeh]

Bump