Private Sub Worksheet_Calculate()
Dim FormulaStartRow As Long, LastRowValue1 As Long
Dim FormulaColumn As String, Value1Column As String
FormulaColumn = "E"
FormulaStartRow = 2
Value1Column = "B"
LastRowValue1 = Range(Value1Column & Rows.Count).End(xlUp).Row
If Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
":" & FormulaColumn & LastRowValue1), "1") > 0 Or _
Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
":" & FormulaColumn & LastRowValue1), "-1") > 0 Then
Dim DestinationSheetExists As Boolean
Dim FormulaColumnRow As Long, OutputArrayRow As Long
Dim LastDestinationColumnNumber As Long
Dim RowOffset As Long
Dim DestinationSheet As String
Dim FormulaColumnArray As Variant, OutputArray As Variant, PreviousFormulaResultArray As Variant
Dim wsDestination As Worksheet, wsSource As Worksheet
DestinationSheet = "TenMinuteUpdates"
Set wsSource = Sheets("Sheet1")
On Error Resume Next
Set wsDestination = Sheets(DestinationSheet)
On Error GoTo 0
If Not wsDestination Is Nothing Then DestinationSheetExists = True
If DestinationSheetExists = False Then
Sheets.Add(After:=wsSource).Name = DestinationSheet
Set wsDestination = Sheets(DestinationSheet)
End If
FormulaColumnArray = wsSource.Range(FormulaColumn & _
FormulaStartRow & ":" & FormulaColumn & LastRowValue1)
ReDim OutputArray(1 To UBound(FormulaColumnArray))
If wsDestination.Range("A1") = vbNullString Then
wsDestination.Range("A1") = Date
wsDestination.Range("A2") = Time()
wsDestination.Range("A3") = "------------------"
wsDestination.Range("A4").Resize(UBound(FormulaColumnArray)) = _
FormulaColumnArray
wsDestination.UsedRange.EntireColumn.AutoFit
GoTo SubExit
End If
PreviousFormulaResultArray = wsDestination.Range("A4:A" & _
wsDestination.Range("A" & Rows.Count).End(xlUp).Row)
OutputArrayRow = 0
RowOffset = FormulaStartRow - LBound(FormulaColumnArray)
For FormulaColumnRow = 1 To UBound(FormulaColumnArray, 1)
If FormulaColumnArray(FormulaColumnRow, 1) = "1" Or _
FormulaColumnArray(FormulaColumnRow, 1) = "-1" Then
OutputArrayRow = OutputArrayRow + 1
If PreviousFormulaResultArray(FormulaColumnRow, 1) = 0 Then
Application.Speech.Speak "At least one value in the," & _
"formula Column, was changed to, 1, or, -1.", SpeakAsync:=True
OutputArray(OutputArrayRow) = "(" & _
FormulaColumnArray(FormulaColumnRow, 1) & _
") " & "Row # " & FormulaColumnRow + RowOffset
End If
End If
Next
LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
, xlFormulas, , xlByColumns, xlPrevious).Column
wsDestination.Cells(1, LastDestinationColumnNumber + 1) = Date
wsDestination.Cells(2, LastDestinationColumnNumber + 1) = Time()
wsDestination.Cells(3, LastDestinationColumnNumber + 1) = "------------------"
wsDestination.Cells(4, LastDestinationColumnNumber _
+ 1).Resize(UBound(OutputArray)) = _
Application.Transpose(OutputArray)
wsDestination.Range("A1") = Date
wsDestination.Range("A2") = Time()
wsDestination.Range("A3") = "------------------"
wsDestination.Range("A4").Resize(UBound(FormulaColumnArray)) = _
FormulaColumnArray
wsDestination.UsedRange.EntireColumn.AutoFit
End If
SubExit:
End Sub