Private Sub Worksheet_Calculate()
Dim FormulaStartRow As Long, LastRowAssetColummn As Long
Dim DestinationSheet As String
Dim AssetColumn As String, FormulaColumn As String
Dim wsDestination As Worksheet, wsSource As Worksheet
DestinationSheet = "TenMinuteUpdates"
Set wsSource = ThisWorkbook.Sheets("Sheet1")
FormulaColumn = "E"
FormulaStartRow = 2
AssetColumn = "A"
LastRowAssetColummn = wsSource.Range(AssetColumn & Rows.Count).End(xlUp).Row
If Application.CountIf(wsSource.Range(FormulaColumn & FormulaStartRow & _
":" & FormulaColumn & LastRowAssetColummn), "1") > 0 Or _
Application.CountIf(wsSource.Range(FormulaColumn & FormulaStartRow & _
":" & FormulaColumn & LastRowAssetColummn), "-1") > 0 Then
Dim DestinationSheetExists As Boolean
Dim FormulaColumnRow As Long, OutputArrayRow As Long
Dim LastDestinationColumnNumber As Long
Dim RowOffset As Long
Dim AssetColumnArray As Variant, FormulaColumnArray As Variant
Dim OutputArray As Variant, PreviousFormulaResultArray As Variant
On Error Resume Next
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet)
On Error GoTo 0
If Not wsDestination Is Nothing Then DestinationSheetExists = True
If DestinationSheetExists = False Then
ThisWorkbook.Sheets.Add(After:=wsSource).Name = DestinationSheet
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet)
End If
AssetColumnArray = wsSource.Range(AssetColumn & _
FormulaStartRow & ":" & AssetColumn & _
LastRowAssetColummn)
FormulaColumnArray = wsSource.Range(FormulaColumn & _
FormulaStartRow & ":" & FormulaColumn & _
LastRowAssetColummn)
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
If PreviousFormulaResultArray(FormulaColumnRow, 1) = 0 Then
OutputArrayRow = OutputArrayRow + 1
OutputArray(OutputArrayRow) = "(" & _
FormulaColumnArray(FormulaColumnRow, 1) & _
") " & AssetColumnArray(FormulaColumnRow, 1)
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