Private Sub Worksheet_Calculate()
'
' V1.2
' 1st 10 minute refresh will create the destination if it doesn't exist & will save the Formula column results to create a base line to compare to.
' All other 10 minute refreshes will compare the current formula column to the previous formula column and display the row #s that changed to '1' or '-1'.
'
' Check the lines at the top of the script that end with ' <---
' Those lines are the lines that may need to be changed to reflect your particular setup.
'
'
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 this to the name of the sheet to store 10 minute results into
Set wsSource = ThisWorkbook.Sheets("Sheet1") ' <--- Set this to the sheetname that has the '1's & '0's
'
FormulaColumn = "E" ' <--- Set this to the formula Column letter
FormulaStartRow = 2 ' <--- Set this to the start row of formulas in the FormulaColumn
AssetColumn = "A" ' <--- Set this to the Asset Column letter, this column is used to determine last row
'
LastRowAssetColummn = wsSource.Range(AssetColumn & Rows.Count).End(xlUp).Row ' Determine last row of data
'
If Application.CountIf(wsSource.Range(FormulaColumn & FormulaStartRow & _
":" & FormulaColumn & LastRowAssetColummn), "1") > 0 Or _
Application.CountIf(wsSource.Range(FormulaColumn & FormulaStartRow & _
":" & FormulaColumn & LastRowAssetColummn), "-1") > 0 Then ' If the range contains any value of 1 or -1 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 ' Bypass error generated in next line if sheet does not exist
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet) ' Assign DestinationSheet to wsDestination
On Error GoTo 0 ' Turn Excel error handling back on
'
If Not wsDestination Is Nothing Then DestinationSheetExists = True ' Check to see if the DestinationSheet exists
'
' Create DestinationSheet if it doesn't exist
If DestinationSheetExists = False Then ' If DestinationSheet does not exist then ...
ThisWorkbook.Sheets.Add(After:=wsSource).Name = DestinationSheet ' Create the DestinationSheet after the Source sheet
Set wsDestination = ThisWorkbook.Sheets(DestinationSheet) ' Assign the DestinationSheet to wsDestination
End If
'
' Save Assets into array
AssetColumnArray = wsSource.Range(AssetColumn & _
FormulaStartRow & ":" & AssetColumn & _
LastRowAssetColummn) ' Save the values of the Asset Column range into the 2D 1 based AssetColumnArray RC
'
' Save formulas into array
FormulaColumnArray = wsSource.Range(FormulaColumn & _
FormulaStartRow & ":" & FormulaColumn & _
LastRowAssetColummn) ' Save the values of the formula Column range into the 2D 1 based FormulaColumnArray RC
'
ReDim OutputArray(1 To UBound(FormulaColumnArray)) ' Establish # of rows in 1D 1 based OutputArray
'
' Create Saved formula result column on DestinationSheet
If wsDestination.Range("A1") = vbNullString Then
wsDestination.Range("A1") = Date ' Display the Date on DestinationSheet
wsDestination.Range("A2") = Time() ' Display the Time on DestinationSheet
wsDestination.Range("A3") = "------------------" ' Display spacer line on DestinationSheet
'
wsDestination.Range("A4").Resize(UBound(FormulaColumnArray)) = _
FormulaColumnArray ' Display results to DestinationSheet
'
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns
'
GoTo SubExit
End If
'
' Load previous formula results into array
PreviousFormulaResultArray = wsDestination.Range("A4:A" & _
wsDestination.Range("A" & Rows.Count).End(xlUp).Row) ' Load previous formula results into PreviousFormulaResultArray
'
OutputArrayRow = 0 ' Initialize OutputArrayRow to zero
RowOffset = FormulaStartRow - LBound(FormulaColumnArray) ' Determine Row difference between FormulaStartRow and start row of FormulaColumnArray
'
'-------------------------------------------------------------------
'
For FormulaColumnRow = 1 To UBound(FormulaColumnArray, 1) ' Loop through the FormulaColumnArray to check for '1's & '-1's
If FormulaColumnArray(FormulaColumnRow, 1) = "1" Or _
FormulaColumnArray(FormulaColumnRow, 1) = "-1" Then ' If a '1' or '-1' is found then ...
If PreviousFormulaResultArray(FormulaColumnRow, 1) = 0 Then ' If previous value was '0' then ...
OutputArrayRow = OutputArrayRow + 1 ' Increment OutputArrayRow
'
OutputArray(OutputArrayRow) = "(" & _
FormulaColumnArray(FormulaColumnRow, 1) & _
") " & AssetColumnArray(FormulaColumnRow, 1) ' Save the changed to value & Asset into OutputArray
End If
End If
Next ' Loop Back
'
LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
, xlFormulas, , xlByColumns, xlPrevious).Column ' Get last Column Number used in the DestinationSheet
'
wsDestination.Cells(1, LastDestinationColumnNumber + 1) = Date ' Display the Date on DestinationSheet
wsDestination.Cells(2, LastDestinationColumnNumber + 1) = Time() ' Display the Time on DestinationSheet
wsDestination.Cells(3, LastDestinationColumnNumber + 1) = "------------------" ' Display spacer line on DestinationSheet
'
wsDestination.Cells(4, LastDestinationColumnNumber _
+ 1).Resize(UBound(OutputArray)) = _
Application.Transpose(OutputArray) ' Display results to DestinationSheet
'
'Save current formula results to the DestinationSheet
wsDestination.Range("A1") = Date ' Display the Date on DestinationSheet
wsDestination.Range("A2") = Time() ' Display the Time on DestinationSheet
wsDestination.Range("A3") = "------------------" ' Display spacer line on DestinationSheet
'
wsDestination.Range("A4").Resize(UBound(FormulaColumnArray)) = _
FormulaColumnArray ' Display results to DestinationSheet
'
wsDestination.UsedRange.EntireColumn.AutoFit ' Autofit all of the columns
End If
'
'-------------------------------------------------------------------
'
SubExit:
End Sub
no errors anymore !!!
