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
And the workbook change event as this:
Class module code as follows - labelled C_CellColorChange
VBA Code:
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:
VBA Code:
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