Option Explicit
Public WithEvents ExcelWatch As Application
Dim oldArr() As Variant, newArr() As Variant
Private Sub ExcelWatch_SheetCalculate(ByVal Sh As Object)
Dim hit As Long
Select Case Sh.Parent.Name
Case ThisWorkbook.Name
Select Case Sh.Name
Case "Test"
newArr = MakeArr()
hit = ChkArrs()
If hit <> 0 Then _
Call MsgBox("C" & Format(hit, "#0"), vbInformation, "Änderung")
oldArr = newArr
End Select
End Select
End Sub
Private Sub ExcelWatch_WorkbookActivate(ByVal Wb As Workbook)
Select Case Wb.Name
Case ThisWorkbook.Name
newArr = MakeArr(): oldArr = newArr
End Select
End Sub
Private Function MakeArr() As Variant
Dim RngQ As Range, c As Range
On Error GoTo flaw
With Sheets("Test")
Set c = Columns(3)
Set RngQ = Range(c.Cells(1), c.Cells(c.Cells.Count).End(xlUp))
MakeArr = RngQ
End With
flaw:
On Error GoTo 0
End Function
Private Function ChkArrs() As Long
Dim x As Long
On Error GoTo flaw
For x = LBound(newArr, 1) To UBound(newArr, 1)
If newArr(x, 1) <> oldArr(x, 1) Then
ChkArrs = x: Exit For
End If
Next x
flaw:
On Error GoTo 0
End Function