Change in output generated by a macro

Valentino · Apr 5, 2022

Hi everyone,

in another thread, @johnnyL has helped me tremendously by developing a code which regularly checks whether certain conditions in a spreadsheet have been fulfilled.
Every 10 minutes, the macro writes the outcome of these checks to a separate outputsheet, which alerts me to changes in conditions.
What i still would like to achieve, is to change the current notification generated by this macro.
- Current notification: "(1) Asset10" --> (indicating that Asset10 changed from "0" to "1", see blue cell in picture below)
- preferred notification: "(1) Asset10 Completed" --> (so add the value from column B in Sheet1 highlighted in yellow to the notification).

Below please find the code that i have been working with and attached a picture of Sheet1 in the workbook containing the value to be added (in yellow) .

I have been trying to adjust the code myself based on some solutions i found on this forum and elsewhere, but have struggled as after I've changed the code is bugged (my inexperience)

Would someone be able to help me to adjust the code?

Many thanks for thoughts!

Valentino

VBA Code:

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

Valentino · Apr 11, 2022

johnnyL said:

Apologies for forgetting about this thread.

It is way past my bedtime, but I put the following together that I think does what you want, at least it does at this late hour of my thinking:

VBA Code:

Private Sub Worksheet_Calculate()
'
'   V2.1
'
'   1st 10 minute refresh will create the DestinationSheet if it doesn't exist & will save the conditions column results to create a base line to compare to.
'   All other 10 minute refreshes will compare the current condition columns to the previous condition columns and display the Assets that had
'       conditions 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 CurrentConditionsStartRow               As Long, LastRowAssetColummn                As Long
    Dim CurrentConditionsRange                  As Range
    Dim DestinationSheet                        As String
    Dim AssetColumn                             As String, StatusColumn                     As String
    Dim FirstConditionColumn                    As String, SecondConditionColumn            As String
    Dim ConditionsCombinedColumn                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
'
                  AssetColumn = "A"                                     ' <--- Set this to the Asset Column letter, this column is used to determine last row
                 StatusColumn = "B"                                     ' <--- Set this to the column letter of the StatusColumn
         FirstConditionColumn = "C"                                     ' <--- Set this to the column letter of the first condition
        SecondConditionColumn = "D"                                     ' <--- Set this to the column letter of the second condition
     ConditionsCombinedColumn = "E"                                     ' <--- Set this to the column letter of the ConditionsCombined Column
    CurrentConditionsStartRow = 2                                       ' <--- Set this to the start row of CurrentConditions
'
    LastRowAssetColummn = wsSource.Range(AssetColumn & _
            Rows.Count).End(xlUp).Row                                   ' Determine last row of data
'
    Set CurrentConditionsRange = wsSource.Range(FirstConditionColumn & _
            CurrentConditionsStartRow & ":" & SecondConditionColumn & _
            LastRowAssetColummn)                                        ' Establish the ConditionsRange
'
    If Application.CountIf(CurrentConditionsRange, "1") > 0 Or _
            Application.CountIf(CurrentConditionsRange, "-1") > 0 Then         ' If the ConditionsRange contains any value of 1 or -1 then ...
'
        Dim ArrayRowIncremented                 As Boolean, DestinationSheetExists          As Boolean
        Dim ConditionsColumnColumn              As Long, ConditionsColumnRow                As Long
        Dim CurrentConditionValue               As Long
        Dim LastDestinationColumnNumber         As Long
        Dim OutputArrayRow                      As Long
'
        Dim AssetColumnArray                    As Variant, CurrentConditionsArray          As Variant
        Dim DateTimeArray(1 To 2)               As Variant
        Dim PreviousConditionsArray             As Variant, PreviousHeadingsArray(1 To 3)   As Variant
        Dim OutputArray                         As Variant, SourceArray                     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
'
' Load current Conditions into array
        CurrentConditionsArray = CurrentConditionsRange                         '   Load the values of the Condition Columns range into the 2D 1 based
'                                                                               '           ConditionsArray RC
        ReDim OutputArray(1 To UBound(CurrentConditionsArray))                  '   Establish # of rows in 1D 1 based OutputArray
'
        SourceArray = wsSource.Range(AssetColumn & CurrentConditionsStartRow & _
                ":" & ConditionsCombinedColumn & LastRowAssetColummn)           '   Load all source values into SourceArray
'
' Create Saved conditions result columns on DestinationSheet if they haven't been created yet
        If wsDestination.Range("A1") = vbNullString Then                        '   If previous conditions have not been saved then ...
            PreviousHeadingsArray(1) = Date                                     '       Save Date into PreviousHeadingsArray
            PreviousHeadingsArray(2) = Time()                                   '       Save Time into PreviousHeadingsArray
            PreviousHeadingsArray(3) = "------------------"                     '       Save space line into PreviousHeadingsArray
            wsDestination.Range("A1").Resize(UBound(PreviousHeadingsArray, 1)) _
                    = Application.Transpose(PreviousHeadingsArray)              '       Save PreviousHeadingsArray to destination sheet
'
            wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                    UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray '       Display CurrentConditionsArray to DestinationSheet
'
            wsDestination.UsedRange.EntireColumn.AutoFit                        '       Autofit all of the columns
'
            GoTo SubExit                                                        '       Exit this subroutine
        End If
'
' Load previous conditions results into array
        PreviousConditionsArray = wsDestination.Range("A4:B" & _
                wsDestination.Range("A" & Rows.Count).End(xlUp).Row)            '   Load previous conditions results into PreviousConditionsArray
'                                                                               '           AssetColumnArray RC
'-------------------------------------------------------------------
'
' Find and save changes from zero
        OutputArrayRow = 0                                                      '   Initialize OutputArrayRow to zero
'
        For ConditionsColumnRow = 1 To UBound(CurrentConditionsArray, 1)        '   Loop through the CurrentConditionsArray rows to check for '1's & '-1's
            For ConditionsColumnColumn = 1 To UBound(CurrentConditionsArray, 2) '       Loop through the CurrentConditionsArray columns to check for '1's & '-1's
'
                CurrentConditionValue = CurrentConditionsArray(ConditionsColumnRow, _
                        ConditionsColumnColumn)                                 '           Get the CurrentConditionValue
'
                If CurrentConditionValue = "1" Or CurrentConditionValue = "-1" Then '           If a '1' or '-1' is found then ...
'
                    If PreviousConditionsArray(ConditionsColumnRow, _
                            ConditionsColumnColumn) = 0 Then                    '               If previous value was '0' then ...
                        If ArrayRowIncremented = False Then                     '                   If we haven't already incremented OutputArrayRow then ...
                            OutputArrayRow = OutputArrayRow + 1                 '                       Increment OutputArrayRow
                            ArrayRowIncremented = True                          '                       Set ArrayRowIncremented flag = True
                        End If
'
                        If OutputArray(OutputArrayRow) = vbNullString Then      '                   If OutputArray cell is blank then ...
                            OutputArray(OutputArrayRow) = "(" & _
                            SourceArray(ConditionsColumnRow, 5) & ") " & _
                            SourceArray(ConditionsColumnRow, 1) & " " & _
                            SourceArray(ConditionsColumnRow, 2)                 '                       Save desired result to OutputArray
                        End If
                    End If
                End If
            Next                                                                '       Loop Back
'
            ArrayRowIncremented = False                                         '       Reset the ArrayRowIncremented to False
        Next                                                                    '   Loop Back
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
'
        DateTimeArray(1) = Date
        DateTimeArray(2) = Time()
        wsDestination.Cells(1, LastDestinationColumnNumber + _
                1).Resize(UBound(DateTimeArray, 1)) = _
                Application.Transpose(DateTimeArray)                            '   Display Date & Time to Destination sheet
'
        wsDestination.Cells(4, LastDestinationColumnNumber _
                + 1).Resize(UBound(OutputArray)) = _
                Application.Transpose(OutputArray)                              '   Display results to DestinationSheet
'
'-------------------------------------------------------------------
'
'Save ConditionsArray to the DestinationSheet
        wsDestination.Range("A1").Resize(UBound(DateTimeArray, 1)) _
                    = Application.Transpose(DateTimeArray)                      '   Display Date & Time to destination sheet
'
        wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray     '   Display results to DestinationSheet
'
        wsDestination.UsedRange.EntireColumn.AutoFit                            '   Autofit all of the columns
    End If
'
'-------------------------------------------------------------------
'
SubExit:
End Sub

I redid some of the code, so hopefully it didn't go sideways in my late hour thinking.

Let us know how it goes.

Thanks a lot Johnny, no need to work late

but the update is much appreciated!!! I will test today and let you know

Valentino · Apr 11, 2022

johnnyL said:

Apologies for forgetting about this thread.

It is way past my bedtime, but I put the following together that I think does what you want, at least it does at this late hour of my thinking:

VBA Code:

Private Sub Worksheet_Calculate()
'
'   V2.1
'
'   1st 10 minute refresh will create the DestinationSheet if it doesn't exist & will save the conditions column results to create a base line to compare to.
'   All other 10 minute refreshes will compare the current condition columns to the previous condition columns and display the Assets that had
'       conditions 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 CurrentConditionsStartRow               As Long, LastRowAssetColummn                As Long
    Dim CurrentConditionsRange                  As Range
    Dim DestinationSheet                        As String
    Dim AssetColumn                             As String, StatusColumn                     As String
    Dim FirstConditionColumn                    As String, SecondConditionColumn            As String
    Dim ConditionsCombinedColumn                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
'
                  AssetColumn = "A"                                     ' <--- Set this to the Asset Column letter, this column is used to determine last row
                 StatusColumn = "B"                                     ' <--- Set this to the column letter of the StatusColumn
         FirstConditionColumn = "C"                                     ' <--- Set this to the column letter of the first condition
        SecondConditionColumn = "D"                                     ' <--- Set this to the column letter of the second condition
     ConditionsCombinedColumn = "E"                                     ' <--- Set this to the column letter of the ConditionsCombined Column
    CurrentConditionsStartRow = 2                                       ' <--- Set this to the start row of CurrentConditions
'
    LastRowAssetColummn = wsSource.Range(AssetColumn & _
            Rows.Count).End(xlUp).Row                                   ' Determine last row of data
'
    Set CurrentConditionsRange = wsSource.Range(FirstConditionColumn & _
            CurrentConditionsStartRow & ":" & SecondConditionColumn & _
            LastRowAssetColummn)                                        ' Establish the ConditionsRange
'
    If Application.CountIf(CurrentConditionsRange, "1") > 0 Or _
            Application.CountIf(CurrentConditionsRange, "-1") > 0 Then         ' If the ConditionsRange contains any value of 1 or -1 then ...
'
        Dim ArrayRowIncremented                 As Boolean, DestinationSheetExists          As Boolean
        Dim ConditionsColumnColumn              As Long, ConditionsColumnRow                As Long
        Dim CurrentConditionValue               As Long
        Dim LastDestinationColumnNumber         As Long
        Dim OutputArrayRow                      As Long
'
        Dim AssetColumnArray                    As Variant, CurrentConditionsArray          As Variant
        Dim DateTimeArray(1 To 2)               As Variant
        Dim PreviousConditionsArray             As Variant, PreviousHeadingsArray(1 To 3)   As Variant
        Dim OutputArray                         As Variant, SourceArray                     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
'
' Load current Conditions into array
        CurrentConditionsArray = CurrentConditionsRange                         '   Load the values of the Condition Columns range into the 2D 1 based
'                                                                               '           ConditionsArray RC
        ReDim OutputArray(1 To UBound(CurrentConditionsArray))                  '   Establish # of rows in 1D 1 based OutputArray
'
        SourceArray = wsSource.Range(AssetColumn & CurrentConditionsStartRow & _
                ":" & ConditionsCombinedColumn & LastRowAssetColummn)           '   Load all source values into SourceArray
'
' Create Saved conditions result columns on DestinationSheet if they haven't been created yet
        If wsDestination.Range("A1") = vbNullString Then                        '   If previous conditions have not been saved then ...
            PreviousHeadingsArray(1) = Date                                     '       Save Date into PreviousHeadingsArray
            PreviousHeadingsArray(2) = Time()                                   '       Save Time into PreviousHeadingsArray
            PreviousHeadingsArray(3) = "------------------"                     '       Save space line into PreviousHeadingsArray
            wsDestination.Range("A1").Resize(UBound(PreviousHeadingsArray, 1)) _
                    = Application.Transpose(PreviousHeadingsArray)              '       Save PreviousHeadingsArray to destination sheet
'
            wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                    UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray '       Display CurrentConditionsArray to DestinationSheet
'
            wsDestination.UsedRange.EntireColumn.AutoFit                        '       Autofit all of the columns
'
            GoTo SubExit                                                        '       Exit this subroutine
        End If
'
' Load previous conditions results into array
        PreviousConditionsArray = wsDestination.Range("A4:B" & _
                wsDestination.Range("A" & Rows.Count).End(xlUp).Row)            '   Load previous conditions results into PreviousConditionsArray
'                                                                               '           AssetColumnArray RC
'-------------------------------------------------------------------
'
' Find and save changes from zero
        OutputArrayRow = 0                                                      '   Initialize OutputArrayRow to zero
'
        For ConditionsColumnRow = 1 To UBound(CurrentConditionsArray, 1)        '   Loop through the CurrentConditionsArray rows to check for '1's & '-1's
            For ConditionsColumnColumn = 1 To UBound(CurrentConditionsArray, 2) '       Loop through the CurrentConditionsArray columns to check for '1's & '-1's
'
                CurrentConditionValue = CurrentConditionsArray(ConditionsColumnRow, _
                        ConditionsColumnColumn)                                 '           Get the CurrentConditionValue
'
                If CurrentConditionValue = "1" Or CurrentConditionValue = "-1" Then '           If a '1' or '-1' is found then ...
'
                    If PreviousConditionsArray(ConditionsColumnRow, _
                            ConditionsColumnColumn) = 0 Then                    '               If previous value was '0' then ...
                        If ArrayRowIncremented = False Then                     '                   If we haven't already incremented OutputArrayRow then ...
                            OutputArrayRow = OutputArrayRow + 1                 '                       Increment OutputArrayRow
                            ArrayRowIncremented = True                          '                       Set ArrayRowIncremented flag = True
                        End If
'
                        If OutputArray(OutputArrayRow) = vbNullString Then      '                   If OutputArray cell is blank then ...
                            OutputArray(OutputArrayRow) = "(" & _
                            SourceArray(ConditionsColumnRow, 5) & ") " & _
                            SourceArray(ConditionsColumnRow, 1) & " " & _
                            SourceArray(ConditionsColumnRow, 2)                 '                       Save desired result to OutputArray
                        End If
                    End If
                End If
            Next                                                                '       Loop Back
'
            ArrayRowIncremented = False                                         '       Reset the ArrayRowIncremented to False
        Next                                                                    '   Loop Back
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
'
        DateTimeArray(1) = Date
        DateTimeArray(2) = Time()
        wsDestination.Cells(1, LastDestinationColumnNumber + _
                1).Resize(UBound(DateTimeArray, 1)) = _
                Application.Transpose(DateTimeArray)                            '   Display Date & Time to Destination sheet
'
        wsDestination.Cells(4, LastDestinationColumnNumber _
                + 1).Resize(UBound(OutputArray)) = _
                Application.Transpose(OutputArray)                              '   Display results to DestinationSheet
'
'-------------------------------------------------------------------
'
'Save ConditionsArray to the DestinationSheet
        wsDestination.Range("A1").Resize(UBound(DateTimeArray, 1)) _
                    = Application.Transpose(DateTimeArray)                      '   Display Date & Time to destination sheet
'
        wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray     '   Display results to DestinationSheet
'
        wsDestination.UsedRange.EntireColumn.AutoFit                            '   Autofit all of the columns
    End If
'
'-------------------------------------------------------------------
'
SubExit:
End Sub

I redid some of the code, so hopefully it didn't go sideways in my late hour thinking.

Let us know how it goes.

johnnyL said:

Apologies for forgetting about this thread.

It is way past my bedtime, but I put the following together that I think does what you want, at least it does at this late hour of my thinking:

VBA Code:

Private Sub Worksheet_Calculate()
'
'   V2.1
'
'   1st 10 minute refresh will create the DestinationSheet if it doesn't exist & will save the conditions column results to create a base line to compare to.
'   All other 10 minute refreshes will compare the current condition columns to the previous condition columns and display the Assets that had
'       conditions 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 CurrentConditionsStartRow               As Long, LastRowAssetColummn                As Long
    Dim CurrentConditionsRange                  As Range
    Dim DestinationSheet                        As String
    Dim AssetColumn                             As String, StatusColumn                     As String
    Dim FirstConditionColumn                    As String, SecondConditionColumn            As String
    Dim ConditionsCombinedColumn                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
'
                  AssetColumn = "A"                                     ' <--- Set this to the Asset Column letter, this column is used to determine last row
                 StatusColumn = "B"                                     ' <--- Set this to the column letter of the StatusColumn
         FirstConditionColumn = "C"                                     ' <--- Set this to the column letter of the first condition
        SecondConditionColumn = "D"                                     ' <--- Set this to the column letter of the second condition
     ConditionsCombinedColumn = "E"                                     ' <--- Set this to the column letter of the ConditionsCombined Column
    CurrentConditionsStartRow = 2                                       ' <--- Set this to the start row of CurrentConditions
'
    LastRowAssetColummn = wsSource.Range(AssetColumn & _
            Rows.Count).End(xlUp).Row                                   ' Determine last row of data
'
    Set CurrentConditionsRange = wsSource.Range(FirstConditionColumn & _
            CurrentConditionsStartRow & ":" & SecondConditionColumn & _
            LastRowAssetColummn)                                        ' Establish the ConditionsRange
'
    If Application.CountIf(CurrentConditionsRange, "1") > 0 Or _
            Application.CountIf(CurrentConditionsRange, "-1") > 0 Then         ' If the ConditionsRange contains any value of 1 or -1 then ...
'
        Dim ArrayRowIncremented                 As Boolean, DestinationSheetExists          As Boolean
        Dim ConditionsColumnColumn              As Long, ConditionsColumnRow                As Long
        Dim CurrentConditionValue               As Long
        Dim LastDestinationColumnNumber         As Long
        Dim OutputArrayRow                      As Long
'
        Dim AssetColumnArray                    As Variant, CurrentConditionsArray          As Variant
        Dim DateTimeArray(1 To 2)               As Variant
        Dim PreviousConditionsArray             As Variant, PreviousHeadingsArray(1 To 3)   As Variant
        Dim OutputArray                         As Variant, SourceArray                     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
'
' Load current Conditions into array
        CurrentConditionsArray = CurrentConditionsRange                         '   Load the values of the Condition Columns range into the 2D 1 based
'                                                                               '           ConditionsArray RC
        ReDim OutputArray(1 To UBound(CurrentConditionsArray))                  '   Establish # of rows in 1D 1 based OutputArray
'
        SourceArray = wsSource.Range(AssetColumn & CurrentConditionsStartRow & _
                ":" & ConditionsCombinedColumn & LastRowAssetColummn)           '   Load all source values into SourceArray
'
' Create Saved conditions result columns on DestinationSheet if they haven't been created yet
        If wsDestination.Range("A1") = vbNullString Then                        '   If previous conditions have not been saved then ...
            PreviousHeadingsArray(1) = Date                                     '       Save Date into PreviousHeadingsArray
            PreviousHeadingsArray(2) = Time()                                   '       Save Time into PreviousHeadingsArray
            PreviousHeadingsArray(3) = "------------------"                     '       Save space line into PreviousHeadingsArray
            wsDestination.Range("A1").Resize(UBound(PreviousHeadingsArray, 1)) _
                    = Application.Transpose(PreviousHeadingsArray)              '       Save PreviousHeadingsArray to destination sheet
'
            wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                    UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray '       Display CurrentConditionsArray to DestinationSheet
'
            wsDestination.UsedRange.EntireColumn.AutoFit                        '       Autofit all of the columns
'
            GoTo SubExit                                                        '       Exit this subroutine
        End If
'
' Load previous conditions results into array
        PreviousConditionsArray = wsDestination.Range("A4:B" & _
                wsDestination.Range("A" & Rows.Count).End(xlUp).Row)            '   Load previous conditions results into PreviousConditionsArray
'                                                                               '           AssetColumnArray RC
'-------------------------------------------------------------------
'
' Find and save changes from zero
        OutputArrayRow = 0                                                      '   Initialize OutputArrayRow to zero
'
        For ConditionsColumnRow = 1 To UBound(CurrentConditionsArray, 1)        '   Loop through the CurrentConditionsArray rows to check for '1's & '-1's
            For ConditionsColumnColumn = 1 To UBound(CurrentConditionsArray, 2) '       Loop through the CurrentConditionsArray columns to check for '1's & '-1's
'
                CurrentConditionValue = CurrentConditionsArray(ConditionsColumnRow, _
                        ConditionsColumnColumn)                                 '           Get the CurrentConditionValue
'
                If CurrentConditionValue = "1" Or CurrentConditionValue = "-1" Then '           If a '1' or '-1' is found then ...
'
                    If PreviousConditionsArray(ConditionsColumnRow, _
                            ConditionsColumnColumn) = 0 Then                    '               If previous value was '0' then ...
                        If ArrayRowIncremented = False Then                     '                   If we haven't already incremented OutputArrayRow then ...
                            OutputArrayRow = OutputArrayRow + 1                 '                       Increment OutputArrayRow
                            ArrayRowIncremented = True                          '                       Set ArrayRowIncremented flag = True
                        End If
'
                        If OutputArray(OutputArrayRow) = vbNullString Then      '                   If OutputArray cell is blank then ...
                            OutputArray(OutputArrayRow) = "(" & _
                            SourceArray(ConditionsColumnRow, 5) & ") " & _
                            SourceArray(ConditionsColumnRow, 1) & " " & _
                            SourceArray(ConditionsColumnRow, 2)                 '                       Save desired result to OutputArray
                        End If
                    End If
                End If
            Next                                                                '       Loop Back
'
            ArrayRowIncremented = False                                         '       Reset the ArrayRowIncremented to False
        Next                                                                    '   Loop Back
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
'
        DateTimeArray(1) = Date
        DateTimeArray(2) = Time()
        wsDestination.Cells(1, LastDestinationColumnNumber + _
                1).Resize(UBound(DateTimeArray, 1)) = _
                Application.Transpose(DateTimeArray)                            '   Display Date & Time to Destination sheet
'
        wsDestination.Cells(4, LastDestinationColumnNumber _
                + 1).Resize(UBound(OutputArray)) = _
                Application.Transpose(OutputArray)                              '   Display results to DestinationSheet
'
'-------------------------------------------------------------------
'
'Save ConditionsArray to the DestinationSheet
        wsDestination.Range("A1").Resize(UBound(DateTimeArray, 1)) _
                    = Application.Transpose(DateTimeArray)                      '   Display Date & Time to destination sheet
'
        wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray     '   Display results to DestinationSheet
'
        wsDestination.UsedRange.EntireColumn.AutoFit                            '   Autofit all of the columns
    End If
'
'-------------------------------------------------------------------
'
SubExit:
End Sub

I redid some of the code, so hopefully it didn't go sideways in my late hour thinking.

Let us know how it goes.

Johnny,

i tested the code and the notfication is exactly as should be! thanks a lot for that.

When testing, after i changed some unrelated (simple) formulas elsewhere in the workbook, i did encounter a runtime error (-2147417848 /80010108, see attachment).
After changing the particular formula, it seems that the macro start to iterate a lot and inserts a lot of columns in the destination sheet, then is overloaded by the no. of columns (also see attached part of the code from debug).
I revisited an older version of the workbook, and already in there it happened i notice now that i change the formula.

I checked some other threads in this forum on this runtime error (eg see link below), but the causes seem very diverse and solution complex. Do you happen to know a solution for this particular code?
I could open a new thread or share the workbook if more convenient.

Many thanks again!

Excel userform Run-time error '21474178 (80010108)': Automation error Object invoked has disconnected from its clients

Hi, I have a problem with a vba project created some time ago. The project contains multiple userforms. On open a userform is shown, and based on some simple choices another userform is loaded. This is when the project gives the following error: Run-time error '21474178 (80010108)'...

www.mrexcel.com

johnnyL · Apr 11, 2022

See if this solves the problem:

VBA Code:

Private Sub Worksheet_Calculate()
'
'   V2.2
'
'   1st 10 minute refresh will create the DestinationSheet if it doesn't exist & will save the conditions column results to create a base line to compare to.
'   All other 10 minute refreshes will compare the current condition columns to the previous condition columns and display the Assets that had
'       conditions 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 CurrentConditionsStartRow               As Long, LastRowAssetColummn                As Long
    Dim CurrentConditionsRange                  As Range
    Dim DestinationSheet                        As String
    Dim AssetColumn                             As String, StatusColumn                     As String
    Dim FirstConditionColumn                    As String, SecondConditionColumn            As String
    Dim ConditionsCombinedColumn                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
'
                  AssetColumn = "A"                                     ' <--- Set this to the Asset Column letter, this column is used to determine last row
                 StatusColumn = "B"                                     ' <--- Set this to the column letter of the StatusColumn
         FirstConditionColumn = "C"                                     ' <--- Set this to the column letter of the first condition
        SecondConditionColumn = "D"                                     ' <--- Set this to the column letter of the second condition
     ConditionsCombinedColumn = "E"                                     ' <--- Set this to the column letter of the ConditionsCombined Column
    CurrentConditionsStartRow = 2                                       ' <--- Set this to the start row of CurrentConditions
'
    LastRowAssetColummn = wsSource.Range(AssetColumn & _
            Rows.Count).End(xlUp).Row                                   ' Determine last row of data
'
    Set CurrentConditionsRange = wsSource.Range(FirstConditionColumn & _
            CurrentConditionsStartRow & ":" & SecondConditionColumn & _
            LastRowAssetColummn)                                        ' Establish the ConditionsRange
'
        Dim ArrayRowIncremented                 As Boolean, DestinationSheetExists          As Boolean
        Dim ConditionsColumnColumn              As Long, ConditionsColumnRow                As Long
        Dim CurrentConditionValue               As Long
        Dim LastDestinationColumnNumber         As Long
        Dim OutputArrayRow                      As Long
'
        Dim AssetColumnArray                    As Variant, CurrentConditionsArray          As Variant
        Dim DateTimeArray(1 To 2)               As Variant
        Dim PreviousConditionsArray             As Variant, PreviousHeadingsArray(1 To 3)   As Variant
        Dim OutputArray                         As Variant, SourceArray                     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
'
' Load current Conditions into array
        CurrentConditionsArray = CurrentConditionsRange                         '   Load the values of the Condition Columns range into the 2D 1 based
'                                                                               '           ConditionsArray RC
        ReDim OutputArray(1 To UBound(CurrentConditionsArray))                  '   Establish # of rows in 1D 1 based OutputArray
'
        SourceArray = wsSource.Range(AssetColumn & CurrentConditionsStartRow & _
                ":" & ConditionsCombinedColumn & LastRowAssetColummn)           '   Load all source values into SourceArray
'
' Create Saved conditions result columns on DestinationSheet if they haven't been created yet
        If wsDestination.Range("A1") = vbNullString Then                        '   If previous conditions have not been saved then ...
            PreviousHeadingsArray(1) = Date                                     '       Save Date into PreviousHeadingsArray
            PreviousHeadingsArray(2) = Time()                                   '       Save Time into PreviousHeadingsArray
            PreviousHeadingsArray(3) = "------------------"                     '       Save space line into PreviousHeadingsArray
            wsDestination.Range("A1").Resize(UBound(PreviousHeadingsArray, 1)) _
                    = Application.Transpose(PreviousHeadingsArray)              '       Save PreviousHeadingsArray to destination sheet
'
            wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                    UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray '       Display CurrentConditionsArray to DestinationSheet
'
            wsDestination.UsedRange.EntireColumn.AutoFit                        '       Autofit all of the columns
'
            GoTo SubExit                                                        '       Exit this subroutine
        End If
'
' Load previous conditions results into array
        PreviousConditionsArray = wsDestination.Range("A4:B" & _
                wsDestination.Range("A" & Rows.Count).End(xlUp).Row)            '   Load previous conditions results into PreviousConditionsArray
'                                                                               '           AssetColumnArray RC
'-------------------------------------------------------------------
'
' Find and save changes from zero
        OutputArrayRow = 0                                                      '   Initialize OutputArrayRow to zero
'
        For ConditionsColumnRow = 1 To UBound(CurrentConditionsArray, 1)        '   Loop through the CurrentConditionsArray rows to check for '1's & '-1's
            For ConditionsColumnColumn = 1 To UBound(CurrentConditionsArray, 2) '       Loop through the CurrentConditionsArray columns to check for '1's & '-1's
'
                CurrentConditionValue = CurrentConditionsArray(ConditionsColumnRow, _
                        ConditionsColumnColumn)                                 '           Get the CurrentConditionValue
'
                If CurrentConditionValue = "1" Or CurrentConditionValue = "-1" Then '           If a '1' or '-1' is found then ...
'
                    If PreviousConditionsArray(ConditionsColumnRow, _
                            ConditionsColumnColumn) = 0 Then                    '               If previous value was '0' then ...
                        If ArrayRowIncremented = False Then                     '                   If we haven't already incremented OutputArrayRow then ...
                            OutputArrayRow = OutputArrayRow + 1                 '                       Increment OutputArrayRow
                            ArrayRowIncremented = True                          '                       Set ArrayRowIncremented flag = True
                        End If
'
                        If OutputArray(OutputArrayRow) = vbNullString Then      '                   If OutputArray cell is blank then ...
                            OutputArray(OutputArrayRow) = "(" & _
                            SourceArray(ConditionsColumnRow, 5) & ") " & _
                            SourceArray(ConditionsColumnRow, 1) & " " & _
                            SourceArray(ConditionsColumnRow, 2)                 '                       Save desired result to OutputArray
                        End If
                    End If
                End If
            Next                                                                '       Loop Back
'
            ArrayRowIncremented = False                                         '       Reset the ArrayRowIncremented to False
        Next                                                                    '   Loop Back
'
        If OutputArrayRow = 0 Then Exit Sub                                     '   If the range we are monitoring didn't change then exit the subroutine
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
'
        DateTimeArray(1) = Date
        DateTimeArray(2) = Time()
        wsDestination.Cells(1, LastDestinationColumnNumber + _
                1).Resize(UBound(DateTimeArray, 1)) = _
                Application.Transpose(DateTimeArray)                            '   Display Date & Time to Destination sheet
'
        wsDestination.Cells(4, LastDestinationColumnNumber _
                + 1).Resize(UBound(OutputArray)) = _
                Application.Transpose(OutputArray)                              '   Display results to DestinationSheet
'
'-------------------------------------------------------------------
'
'Save ConditionsArray to the DestinationSheet
        wsDestination.Range("A1").Resize(UBound(DateTimeArray, 1)) _
                    = Application.Transpose(DateTimeArray)                      '   Display Date & Time to destination sheet
'
        wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray     '   Display results to DestinationSheet
'
        wsDestination.UsedRange.EntireColumn.AutoFit                            '   Autofit all of the columns
'
'-------------------------------------------------------------------
'
SubExit:
End Sub

Valentino · Apr 11, 2022

johnnyL said:

See if this solves the problem:

VBA Code:

Private Sub Worksheet_Calculate()
'
'   V2.2
'
'   1st 10 minute refresh will create the DestinationSheet if it doesn't exist & will save the conditions column results to create a base line to compare to.
'   All other 10 minute refreshes will compare the current condition columns to the previous condition columns and display the Assets that had
'       conditions 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 CurrentConditionsStartRow               As Long, LastRowAssetColummn                As Long
    Dim CurrentConditionsRange                  As Range
    Dim DestinationSheet                        As String
    Dim AssetColumn                             As String, StatusColumn                     As String
    Dim FirstConditionColumn                    As String, SecondConditionColumn            As String
    Dim ConditionsCombinedColumn                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
'
                  AssetColumn = "A"                                     ' <--- Set this to the Asset Column letter, this column is used to determine last row
                 StatusColumn = "B"                                     ' <--- Set this to the column letter of the StatusColumn
         FirstConditionColumn = "C"                                     ' <--- Set this to the column letter of the first condition
        SecondConditionColumn = "D"                                     ' <--- Set this to the column letter of the second condition
     ConditionsCombinedColumn = "E"                                     ' <--- Set this to the column letter of the ConditionsCombined Column
    CurrentConditionsStartRow = 2                                       ' <--- Set this to the start row of CurrentConditions
'
    LastRowAssetColummn = wsSource.Range(AssetColumn & _
            Rows.Count).End(xlUp).Row                                   ' Determine last row of data
'
    Set CurrentConditionsRange = wsSource.Range(FirstConditionColumn & _
            CurrentConditionsStartRow & ":" & SecondConditionColumn & _
            LastRowAssetColummn)                                        ' Establish the ConditionsRange
'
        Dim ArrayRowIncremented                 As Boolean, DestinationSheetExists          As Boolean
        Dim ConditionsColumnColumn              As Long, ConditionsColumnRow                As Long
        Dim CurrentConditionValue               As Long
        Dim LastDestinationColumnNumber         As Long
        Dim OutputArrayRow                      As Long
'
        Dim AssetColumnArray                    As Variant, CurrentConditionsArray          As Variant
        Dim DateTimeArray(1 To 2)               As Variant
        Dim PreviousConditionsArray             As Variant, PreviousHeadingsArray(1 To 3)   As Variant
        Dim OutputArray                         As Variant, SourceArray                     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
'
' Load current Conditions into array
        CurrentConditionsArray = CurrentConditionsRange                         '   Load the values of the Condition Columns range into the 2D 1 based
'                                                                               '           ConditionsArray RC
        ReDim OutputArray(1 To UBound(CurrentConditionsArray))                  '   Establish # of rows in 1D 1 based OutputArray
'
        SourceArray = wsSource.Range(AssetColumn & CurrentConditionsStartRow & _
                ":" & ConditionsCombinedColumn & LastRowAssetColummn)           '   Load all source values into SourceArray
'
' Create Saved conditions result columns on DestinationSheet if they haven't been created yet
        If wsDestination.Range("A1") = vbNullString Then                        '   If previous conditions have not been saved then ...
            PreviousHeadingsArray(1) = Date                                     '       Save Date into PreviousHeadingsArray
            PreviousHeadingsArray(2) = Time()                                   '       Save Time into PreviousHeadingsArray
            PreviousHeadingsArray(3) = "------------------"                     '       Save space line into PreviousHeadingsArray
            wsDestination.Range("A1").Resize(UBound(PreviousHeadingsArray, 1)) _
                    = Application.Transpose(PreviousHeadingsArray)              '       Save PreviousHeadingsArray to destination sheet
'
            wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                    UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray '       Display CurrentConditionsArray to DestinationSheet
'
            wsDestination.UsedRange.EntireColumn.AutoFit                        '       Autofit all of the columns
'
            GoTo SubExit                                                        '       Exit this subroutine
        End If
'
' Load previous conditions results into array
        PreviousConditionsArray = wsDestination.Range("A4:B" & _
                wsDestination.Range("A" & Rows.Count).End(xlUp).Row)            '   Load previous conditions results into PreviousConditionsArray
'                                                                               '           AssetColumnArray RC
'-------------------------------------------------------------------
'
' Find and save changes from zero
        OutputArrayRow = 0                                                      '   Initialize OutputArrayRow to zero
'
        For ConditionsColumnRow = 1 To UBound(CurrentConditionsArray, 1)        '   Loop through the CurrentConditionsArray rows to check for '1's & '-1's
            For ConditionsColumnColumn = 1 To UBound(CurrentConditionsArray, 2) '       Loop through the CurrentConditionsArray columns to check for '1's & '-1's
'
                CurrentConditionValue = CurrentConditionsArray(ConditionsColumnRow, _
                        ConditionsColumnColumn)                                 '           Get the CurrentConditionValue
'
                If CurrentConditionValue = "1" Or CurrentConditionValue = "-1" Then '           If a '1' or '-1' is found then ...
'
                    If PreviousConditionsArray(ConditionsColumnRow, _
                            ConditionsColumnColumn) = 0 Then                    '               If previous value was '0' then ...
                        If ArrayRowIncremented = False Then                     '                   If we haven't already incremented OutputArrayRow then ...
                            OutputArrayRow = OutputArrayRow + 1                 '                       Increment OutputArrayRow
                            ArrayRowIncremented = True                          '                       Set ArrayRowIncremented flag = True
                        End If
'
                        If OutputArray(OutputArrayRow) = vbNullString Then      '                   If OutputArray cell is blank then ...
                            OutputArray(OutputArrayRow) = "(" & _
                            SourceArray(ConditionsColumnRow, 5) & ") " & _
                            SourceArray(ConditionsColumnRow, 1) & " " & _
                            SourceArray(ConditionsColumnRow, 2)                 '                       Save desired result to OutputArray
                        End If
                    End If
                End If
            Next                                                                '       Loop Back
'
            ArrayRowIncremented = False                                         '       Reset the ArrayRowIncremented to False
        Next                                                                    '   Loop Back
'
        If OutputArrayRow = 0 Then Exit Sub                                     '   If the range we are monitoring didn't change then exit the subroutine
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
'
        DateTimeArray(1) = Date
        DateTimeArray(2) = Time()
        wsDestination.Cells(1, LastDestinationColumnNumber + _
                1).Resize(UBound(DateTimeArray, 1)) = _
                Application.Transpose(DateTimeArray)                            '   Display Date & Time to Destination sheet
'
        wsDestination.Cells(4, LastDestinationColumnNumber _
                + 1).Resize(UBound(OutputArray)) = _
                Application.Transpose(OutputArray)                              '   Display results to DestinationSheet
'
'-------------------------------------------------------------------
'
'Save ConditionsArray to the DestinationSheet
        wsDestination.Range("A1").Resize(UBound(DateTimeArray, 1)) _
                    = Application.Transpose(DateTimeArray)                      '   Display Date & Time to destination sheet
'
        wsDestination.Range("A4").Resize(UBound(CurrentConditionsArray, 1), _
                UBound(CurrentConditionsArray, 2)) = CurrentConditionsArray     '   Display results to DestinationSheet
'
        wsDestination.UsedRange.EntireColumn.AutoFit                            '   Autofit all of the columns
'
'-------------------------------------------------------------------
'
SubExit:
End Sub

Thanks for the new version! Immediately tested it, and noticed that now only 1 asset was printed in the output with each 10min update...even when multiple other assets also changed from "0" to "1" or "-1" (which should also have been printed, as they did in the 2.1 version of the code)

Also, the runtime error seemed to be gone initially but as i changed some values elsewhere in the workbook it happened again... see attached screenprints

Would it help if i attached the workbook..?

Thanks!!!

johnnyL · Apr 11, 2022

You can't attach it, but you could upload it to a site and then provide the link to it.

Valentino · Apr 11, 2022

johnnyL said:
You can't attach it, but you could upload it to a site and then provide the link to it.

Would you be willing to take a look at it if i did...? that would be much appreciated

I have experience sharing files through Dropbox, if you think thats the best alternative i can give access but would need your email i think (you could dm me?)
thanks again!

johnnyL · Apr 11, 2022

If it's not a link you can provide to everyone then I don't want to see it.

If it is a file you can share publicly, you can upload it to this site . Then provide the link it gives you.

Valentino · Apr 11, 2022

johnnyL said:
If it's not a link you can provide to everyone then I don't want to see it.

If it is a file you can share publicly, you can upload it to this site . Then provide the link it gives you.

Thanks, i didn't know this site. Uploaded the file, see url below - of course anyone can see!!
This version includes code version 2.1, since i really like how that version refreshes and output notification.

I attached a screenprint to show what formula causes the runtime error: you can see that it happens when i copy this formula in column X of the Daily sheet.

thanks for your thoughts again!

Gofile - Free Unlimited File Sharing and Storage

Gofile is a free, secure file sharing and storage platform. With unlimited bandwidth and storage, you can easily store and share files of any type without any limits. Our advanced features, such as CDN support and password protection, make Gofile the ideal choice for individuals and businesses...

gofile.io

Valentino · Apr 13, 2022

johnnyL said:
If it's not a link you can provide to everyone then I don't want to see it.

If it is a file you can share publicly, you can upload it to this site . Then provide the link it gives you.

Hi @johnnyL , did you get to see the file i uploaded...? Was wondering if it worked and you could open it..? Would much appreciate your feedback, no hurry though and just when it suits you!

Thanks!

johnnyL · Apr 13, 2022

@Valentino , It sounds like you have used up all of the columns on the 'TenMinuteUpdates' sheet when the script went all haywire on you.

Delete that sheet so you can start over when the script creates the new one.

Next, change the line that you noted reports an error to the following:

VBA Code:

        If OutputArrayRow = 0 Then Exit Sub
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet

Then start the script to see if it solves the script issue of numerous columns being written to the destination sheet.

Let us know where you stand after trying that.

Change in output generated by a macro

Valentino

Board Regular

Attachments

Valentino

Board Regular

Excel Facts

Valentino

Board Regular

Excel userform Run-time error '21474178 (80010108)': Automation error Object invoked has disconnected from its clients

Attachments

johnnyL

Well-known Member

Valentino

Board Regular

Attachments

johnnyL

Well-known Member

Valentino

Board Regular

johnnyL

Well-known Member

Valentino

Board Regular

Gofile - Free Unlimited File Sharing and Storage

Attachments

Valentino

Board Regular

johnnyL

Well-known Member

Similar threads

Forum statistics

Share this page

Change in output generated by a macro

Board Regular

Attachments

Board Regular

Excel Facts

Board Regular

Attachments

Well-known Member

Board Regular

Attachments

Well-known Member

Board Regular

Well-known Member

Board Regular

Attachments

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock