Detect when individual cells were changed, cells not in a range...

[spacely]

Hello,

I have a snippet of code which detects when a cell in a range is changed. I'd like to use it to detect when several cells not in a continuous range on the same sheet are changed...one option would be to define a bunch of ranges and do-while through them all, I guess. here's my starting point. Maybe there's a better way?:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim KeyCells As Range

Set KeyCells = Range("AK98")

If Not Application.Intersect(KeyCells, Range(Target.Address)) Is Nothing Then
MsgBox "Cell " & Target.Address & " has changed."
End If
End Sub

 

[spacely]

I poked around on the forums, and solved it:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim KeyCells As Range
Dim isect As Range
Dim cell As Range
Dim rDependents As Range

If [captureCellHistory].Value = 1 Then
Set KeyCells = Range("S:ZZ") ' should be big enough to capture all hardware added, I hope...specify non-continuous ranges like: Range("AK98, AL99, AN101:AN104")
Set isect = Intersect(KeyCells, Target)

If Not isect Is Nothing Then ' detects things typed into cells, and if a VBA script changes the cell value. Doesn't detect changes due to recalculations due to cell formulas!
For Each cell In isect
lastRow = Worksheets("cell histories").Cells(Rows.Count, 1).End(xlUp).Row ' add onto bottom of cell history list
Worksheets("cell histories").Cells(lastRow + 1, 1).Value = Now ' date/time of this edit
Worksheets("cell histories").Cells(lastRow + 1, 2).Value = Application.UserName ' username of person who made edit
Worksheets("cell histories").Cells(lastRow + 1, 3).Value = ActiveSheet.name ' sheet name of this edit
Worksheets("cell histories").Cells(lastRow + 1, 4).Value = cell.Row ' row number of this edit
Worksheets("cell histories").Cells(lastRow + 1, 5).Value = cell.Column ' column number of this edit
Worksheets("cell histories").Cells(lastRow + 1, 6).Value = cell.Value ' cell value of this edit
Next cell
End If

On Error Resume Next
Set rDependents = Target.Dependents
If Err.Number > 0 Then
Exit Sub
End If
Set isect = Intersect(rDependents, KeyCells)
If Not isect Is Nothing Then ' detects cell changes due to formula calculations
For Each cell In isect
lastRow = Worksheets("cell histories").Cells(Rows.Count, 1).End(xlUp).Row ' add onto bottom of cell history list
Worksheets("cell histories").Cells(lastRow + 1, 1).Value = Now ' date/time of this edit
Worksheets("cell histories").Cells(lastRow + 1, 2).Value = Application.UserName ' username of person who made edit
Worksheets("cell histories").Cells(lastRow + 1, 3).Value = ActiveSheet.name ' sheet name of this edit
Worksheets("cell histories").Cells(lastRow + 1, 4).Value = cell.Row ' row number of this edit
Worksheets("cell histories").Cells(lastRow + 1, 5).Value = cell.Column ' column number of this edit
Worksheets("cell histories").Cells(lastRow + 1, 6).Value = cell.Value ' cell value of this edit
Next cell
End If
End If

End Sub