Change in output generated by a macro

V

Valentino

Board Regular
Joined
Mar 28, 2010
Messages
105
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
 

Attachments

  • Pic7.JPG
    Pic7.JPG
    41.7 KB · Views: 27
Sort by date Sort by votes
Actually, you need some additional code to prevent the issue.

Replace all of the code with:
VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V2.3
'
'   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 ...
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            ThisWorkbook.Sheets.Add(after:=wsSource).Name = DestinationSheet    '       Create the DestinationSheet after the Source sheet
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            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
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            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
'
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            Exit Sub                                                        '       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 no changes made that we are monitoring found ... Exit
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
''        LastDestinationColumnNumber = wsDestination.Range("A3").End(xlToRight).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
End Sub

Then delete the destination sheet ... Sheet1. Save, close, & restart the script.

Then let us know.
 
Upvote 0

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
johnnyL said:
Actually, you need some additional code to prevent the issue.

Replace all of the code with:
VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V2.3
'
'   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 ...
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            ThisWorkbook.Sheets.Add(after:=wsSource).Name = DestinationSheet    '       Create the DestinationSheet after the Source sheet
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            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
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            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
'
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            Exit Sub                                                        '       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 no changes made that we are monitoring found ... Exit
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
''        LastDestinationColumnNumber = wsDestination.Range("A3").End(xlToRight).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
End Sub

Then delete the destination sheet ... Sheet1. Save, close, & restart the script.

Then let us know.
Click to expand...
thanks a lot for the update! i tested v2.3 a lot but it seems it is not updating the destination sheet very often and sometimes misses assets for which values changed :-(
Also, i tried to update the v2.1 code with your suggestion from post 20, but also seems to miss changed values.
Additionally, i tried to clean the file where i saw some abundant formulas, and tried to simplify the formula which gives the runtime error, but it keeps on coming.
What i don't get, is why such a simple (vlookup with iserror protection) formula can make the whole macro go beserk...macro works so well otherwise!!

Also, when testing the error i noticed 2 things:
1. it gives the error even when there are still columns available o the right (see pic14; it already gave the error when it was filled up to column AV, while it can theoretically fill until column XFD in my excel) --> is it possible that VBA uses all columns to the right? then maybe i can delete outputsheet before it goes beserk?
2. the macro sometimes writes the same timeslot twice (see pic 13) sometimes --> if this is somehow avoided, maybe it does not go beserk?

Can these two observations maybe lead to a solution?
thanks again
 

Attachments

  • Pic14.JPG
    Pic14.JPG
    20.2 KB · Views: 5
  • Pic13.JPG
    Pic13.JPG
    18.4 KB · Views: 4
Upvote 0
You will have to provide specific examples of what you do that causes the code to trigger when it shouldn't be triggered. My previous code corrects the triggers that I found, but apparently there are more that causes the code to trigger and then error.

Now do you appreciate why I suggested a different thread in that other thread?
 
Upvote 0
johnnyL said:
You will have to provide specific examples of what you do that causes the code to trigger when it shouldn't be triggered. My previous code corrects the triggers that I found, but apparently there are more that causes the code to trigger and then error.

Now do you appreciate why I suggested a different thread in that other thread?
Click to expand...
Johnny, as said the runtime error was solved with the 2.3 code indeed but somehow it seemed to come at the expense of less notifications of asset changes. The latter is very important to me, so i will revert back to code v2.1 which works fantastic in that respect and just drop the feature with the formula causing the runtime error. I am very grateful for the code you provided and will spend the coming weeks testing and finetuning.
Thanks a lot for all your thoughts and input!!!
 
Upvote 0
Made a couple of changes. See how this works:

VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V2.4
'
'   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 ...
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            ThisWorkbook.Sheets.Add(after:=wsSource).Name = DestinationSheet    '       Create the DestinationSheet after the Source sheet
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            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
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            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
'
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            Exit Sub                                                        '       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 OutputArray(1) = "" Then Exit Sub                                     '   If no changes made that we are monitoring found ... Exit
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
''        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Range("A1").End(xlToRight).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
End Sub
 
Upvote 0
johnnyL said:
Made a couple of changes. See how this works:

VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V2.4
'
'   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 ...
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            ThisWorkbook.Sheets.Add(after:=wsSource).Name = DestinationSheet    '       Create the DestinationSheet after the Source sheet
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            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
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            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
'
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            Exit Sub                                                        '       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 OutputArray(1) = "" Then Exit Sub                                     '   If no changes made that we are monitoring found ... Exit
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
''        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Range("A1").End(xlToRight).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
End Sub
Click to expand...
Thanks again Johnny, will test it and report back how it works!!
 
Upvote 0
johnnyL said:
Made a couple of changes. See how this works:

VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V2.4
'
'   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 ...
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            ThisWorkbook.Sheets.Add(after:=wsSource).Name = DestinationSheet    '       Create the DestinationSheet after the Source sheet
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            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
            Application.EnableEvents = False                                    '       Turn EnableEvents off to prevent code from triggering again
            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
'
            Application.EnableEvents = True                                     '       Turn EnableEvents back on
            Exit Sub                                                        '       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 OutputArray(1) = "" Then Exit Sub                                     '   If no changes made that we are monitoring found ... Exit
'
'-------------------------------------------------------------------
'
' Save found changes to the DestinationSheet
''        LastDestinationColumnNumber = wsDestination.Cells.Find("*", _
                , xlFormulas, , xlByColumns, xlPrevious).Column                 '   Get last Column Number used in the DestinationSheet
        LastDestinationColumnNumber = wsDestination.Range("A1").End(xlToRight).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
End Sub
Click to expand...
hmmm...some new errors, and i didn't even copy down the formula which normally triggers the runtime error...workbook is the same as the one which runs fine with v2.1
Aby further thoughts...?

thanks!
 

Attachments

  • Pic16.JPG
    Pic16.JPG
    97 KB · Views: 3
  • Pic15.JPG
    Pic15.JPG
    21.3 KB · Views: 3
Upvote 0
When you get that error, click the 'Debug' and in the line that is highlighted in yellow, hover your mouse over the portion 'LastDestinationColumnNumber'. Tell me what value it shows you when you hover over that.

Also, did you delete the destination sheet prior to running the code?
 
Upvote 0
johnnyL said:
When you get that error, click the 'Debug' and in the line that is highlighted in yellow, hover your mouse over the portion 'LastDestinationColumnNumber'. Tell me what value it shows you when you hover over that.

Also, did you delete the destination sheet prior to running the code?
Click to expand...
Its giving back 16384...thats the number of columns in my ms excel 365 indeed
 
Upvote 0
That is why you are getting that error, you can't add 1 to that number without getting an error, the column doesn't exist.

Can you screenshot your destination sheet when you get that error?
 
Upvote 0
You must log in or register to reply here.

Similar threads

V
  • Solved
VBA copy filtered range
Replies
8
Views
626
Valentino
V
V
  • Solved
One-off code in a loop
Replies
6
Views
450
Valentino
V
E
  • Question Question
Converting a macro to UDF
Replies
0
Views
489
excelNewbie22
E
E
  • Question Question
adjusting a macro "generating combinations by a range"
Replies
3
Views
908
excelNewbie22
E
E
  • Question Question
ignoring blanks in a macro range
Replies
4
Views
538
excelNewbie22
E

Forum statistics

Threads
1,223,911
Messages
6,175,333
Members
452,636
Latest member
laura12345

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top