Excel alerts

V

Valentino

Board Regular
Joined
Mar 28, 2010
Messages
105
Hi everyone,

In an excel file i am refreshing data from a web query every 10 minutes. In the sheet i have some if formulas which check whether certain conditions have been met. If these are met, i would like to get a notification or alert, not necessarily by email but just in excel as i have the file open all day but just not scanning it all the time. Is there an easy way to do this, or can it only be done by vba? Is there some example of this solution/vba script?

Many thanks for your thoughts!!!

Valentino
 
Sort by date Sort by votes
Hello again @Valentino.

As I understand it now, you want to record all of the row #s that change to '-1' or '1', at every 10 minute refresh while the workbook is open?

Do you have access to the code that does the 10 minute refresh of the code? The reason I ask is because we will need to delete the values stored in the Value1 & Value2 columns in order to see which values changed in the formula column E. I can put the code to delete those 2 columns at the end of my code, or you would need to include it into your existing code that does the 10 minute refresh of data. If I put the delete code at the end of my code, you would be left with just the result sheet that shows the rows that changed. If you put the delete code into your existing code, you would be left with the result sheet that shows the rows changed as well as the original sheet of data to compare the rows that changed to.

Also, you didn't say if speakers are available. Does excel ever make sounds that you hear? Normally you would hear a sound when a pop up message occurs during some errors.

Here is a short code to test for sound:
VBA Code: 
Sub SoundTest()
'
    Beep ' Sound a tone.
End Sub
 
Upvote 0
johnnyL said:
Hello again @Valentino.

As I understand it now, you want to record all of the row #s that change to '-1' or '1', at every 10 minute refresh while the workbook is open?

Do you have access to the code that does the 10 minute refresh of the code? The reason I ask is because we will need to delete the values stored in the Value1 & Value2 columns in order to see which values changed in the formula column E. I can put the code to delete those 2 columns at the end of my code, or you would need to include it into your existing code that does the 10 minute refresh of data. If I put the delete code at the end of my code, you would be left with just the result sheet that shows the rows that changed. If you put the delete code into your existing code, you would be left with the result sheet that shows the rows changed as well as the original sheet of data to compare the rows that changed to.

Also, you didn't say if speakers are available. Does excel ever make sounds that you hear? Normally you would hear a sound when a pop up message occurs during some errors.

Here is a short code to test for sound:
VBA Code: 
Sub SoundTest()
'
    Beep ' Sound a tone.
End Sub
Click to expand...
Indeed, all rows should be signalled which changed from zero to another value at every 10 mins the workbook is open.

For the refresh, i don't use code but just the "Data"/"From Web" query functionality built in Excel, with a 10 minutes refresh frequency (see attached image). Thinking of it, perhaps we could come up with a code that could (over)write the existing table as hard value output to a new sheet every 10 minutes, and in the web refreshed table we could include a column with formulas which compare the condition to the hard valued output table, to signal whether there has been an update since refresh--> if so, write the row number to another output sheet?

I don't have sound available. But I will check regularly so it's fine if the macro writes the row numbers which changed to a separate sheet, which i will regularly check to scan for updates.

Hope it's more clear now, thanks!
 

Attachments

  • Pic2.JPG
    Pic2.JPG
    57 KB · Views: 10
Upvote 0
Place the following code into the worksheet module of the sheet that you want it to run on:

VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V1.0
'   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, LastRowValue1  As Long
    Dim FormulaColumn                   As String, Value1Column As String
'
      FormulaColumn = "E"                                           ' <--- Set this to the formula Column letter
    FormulaStartRow = 2                                             ' <--- Set this to the start row of formulas in the FormulaColumn
       Value1Column = "B"                                           ' <--- Set this to the Value1 Column letter, this column is used to determine last row
'
    LastRowValue1 = Range(Value1Column & Rows.Count).End(xlUp).Row  ' Determine last row of data
'
    If Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
            ":" & FormulaColumn & LastRowValue1), "1") > 0 Or _
            Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
            ":" & FormulaColumn & LastRowValue1), "-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 DestinationSheet            As String
        Dim FormulaColumnArray          As Variant, OutputArray As Variant, PreviousFormulaResultArray  As Variant
        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 = Sheets("Sheet1")                             ' <--- Set this to the sheetname that has the '1's & '0's
'
        On Error Resume Next                                        '   Bypass error generated in next line if sheet does not exist
        Set wsDestination = 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 ...
            Sheets.Add(After:=wsSource).Name = DestinationSheet     '       Create the DestinationSheet after the Source sheet
            Set wsDestination = Sheets(DestinationSheet)            '       Assign the DestinationSheet to wsDestination
        End If
'
        FormulaColumnArray = wsSource.Range(FormulaColumn & _
                FormulaStartRow & ":" & FormulaColumn & LastRowValue1)  '   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
'
        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 ...
                OutputArrayRow = OutputArrayRow + 1                 '           Increment OutputArrayRow
'
                If PreviousFormulaResultArray(FormulaColumnRow, 1) = 0 Then '       If previous value was '0' then ...
'
                    Application.Speech.Speak "At least one value in the," & _
                            "formula Column, was changed to, 1, or, -1.", SpeakAsync:=True   '   Audible alert. Commas are a pause in speach ;)
'
                    OutputArray(OutputArrayRow) = "(" & _
                            FormulaColumnArray(FormulaColumnRow, 1) & _
                            ") " & "Row # " & FormulaColumnRow + RowOffset  '           Save the changed to value & row# 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

Let us know how it goes.
 
Upvote 0
johnnyL said:
Place the following code into the worksheet module of the sheet that you want it to run on:

VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V1.0
'   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, LastRowValue1  As Long
    Dim FormulaColumn                   As String, Value1Column As String
'
      FormulaColumn = "E"                                           ' <--- Set this to the formula Column letter
    FormulaStartRow = 2                                             ' <--- Set this to the start row of formulas in the FormulaColumn
       Value1Column = "B"                                           ' <--- Set this to the Value1 Column letter, this column is used to determine last row
'
    LastRowValue1 = Range(Value1Column & Rows.Count).End(xlUp).Row  ' Determine last row of data
'
    If Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
            ":" & FormulaColumn & LastRowValue1), "1") > 0 Or _
            Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
            ":" & FormulaColumn & LastRowValue1), "-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 DestinationSheet            As String
        Dim FormulaColumnArray          As Variant, OutputArray As Variant, PreviousFormulaResultArray  As Variant
        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 = Sheets("Sheet1")                             ' <--- Set this to the sheetname that has the '1's & '0's
'
        On Error Resume Next                                        '   Bypass error generated in next line if sheet does not exist
        Set wsDestination = 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 ...
            Sheets.Add(After:=wsSource).Name = DestinationSheet     '       Create the DestinationSheet after the Source sheet
            Set wsDestination = Sheets(DestinationSheet)            '       Assign the DestinationSheet to wsDestination
        End If
'
        FormulaColumnArray = wsSource.Range(FormulaColumn & _
                FormulaStartRow & ":" & FormulaColumn & LastRowValue1)  '   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
'
        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 ...
                OutputArrayRow = OutputArrayRow + 1                 '           Increment OutputArrayRow
'
                If PreviousFormulaResultArray(FormulaColumnRow, 1) = 0 Then '       If previous value was '0' then ...
'
                    Application.Speech.Speak "At least one value in the," & _
                            "formula Column, was changed to, 1, or, -1.", SpeakAsync:=True   '   Audible alert. Commas are a pause in speach ;)
'
                    OutputArray(OutputArrayRow) = "(" & _
                            FormulaColumnArray(FormulaColumnRow, 1) & _
                            ") " & "Row # " & FormulaColumnRow + RowOffset  '           Save the changed to value & row# 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

Let us know how it goes.
Click to expand...
Thanks, thats quite an effort already! I am testing it and from first glance the idea seems to be effective. First quick observations:
- audible is really not necessary: could i therefore delete this part?
" Application.Speech.Speak "At least one value in the," & _
"formula Column, was changed to, 1, or, -1.", SpeakAsync:=True

- If there is a change, the row number is written to the output sheet. Is it possible to change this into the asset name from column A? so for instance if there is a change in column 68, instead of writing "row#68" could it write the value from cell a68 to the output sheet?

In the meantime i'll test some more, but already many many thanks for this progress!

Valentino
 
Upvote 0
How about:

VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V1.1
'   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 FormulaColumn                   As String, AssetColumn          As String
'
      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 = Range(AssetColumn & Rows.Count).End(xlUp).Row ' Determine last row of data
'
    If Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
            ":" & FormulaColumn & LastRowAssetColummn), "1") > 0 Or _
            Application.CountIf(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 DestinationSheet            As String
        Dim AssetColumnArray            As Variant, FormulaColumnArray          As Variant
        Dim OutputArray                 As Variant, PreviousFormulaResultArray  As Variant
        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 = Sheets("Sheet1")                             ' <--- Set this to the sheetname that has the '1's & '0's
'
        On Error Resume Next                                        '   Bypass error generated in next line if sheet does not exist
        Set wsDestination = 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 ...
            Sheets.Add(After:=wsSource).Name = DestinationSheet     '       Create the DestinationSheet after the Source sheet
            Set wsDestination = 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

Editted: 5 minutes later with code correction.
 
Last edited:
Upvote 0
johnnyL said:
How about:

VBA Code: 
Private Sub Worksheet_Calculate()
'
'   V1.1
'   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 FormulaColumn                   As String, AssetColumn          As String
'
      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 = Range(AssetColumn & Rows.Count).End(xlUp).Row ' Determine last row of data
'
    If Application.CountIf(Range(FormulaColumn & FormulaStartRow & _
            ":" & FormulaColumn & LastRowAssetColummn), "1") > 0 Or _
            Application.CountIf(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 DestinationSheet            As String
        Dim AssetColumnArray            As Variant, FormulaColumnArray          As Variant
        Dim OutputArray                 As Variant, PreviousFormulaResultArray  As Variant
        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 = Sheets("Sheet1")                             ' <--- Set this to the sheetname that has the '1's & '0's
'
        On Error Resume Next                                        '   Bypass error generated in next line if sheet does not exist
        Set wsDestination = 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 ...
            Sheets.Add(After:=wsSource).Name = DestinationSheet     '       Create the DestinationSheet after the Source sheet
            Set wsDestination = 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

Editted: 5 minutes later with code correction.
Click to expand...
Hi Johnny,

I tested the code and many thanks for all the work, the solution works really well!
Only thing is that i cannot use it in background of some other excel work, there seems to be a conflict and its throwing a runtime error (9): see attached picture, is there a workaround for this? I already tried opening a separate Excel session, but did not solve.

Also i thought it is a bit easier if i setup my file differently, so that i can test for 3 conditions per asset. See second picture for this. if the conditions 1 and 2 for eg Asset1 are met (ie changed from 0 to 1), it would mention in the output sheet: "Asset1: Plus-Condition1, Plus-Condition2" (see blue area in picture for notation). Would it be possible to make "Condition1" dynamic, ie when i change the name/table header it will change in the output? Could this be done?

Many thanks again!!!!

Valentino
 

Attachments

  • Pic3.JPG
    Pic3.JPG
    13.8 KB · Views: 11
  • Pic4.JPG
    Pic4.JPG
    26.8 KB · Views: 11
Upvote 0
Valentino said:
Hi Johnny,

I tested the code and many thanks for all the work, the solution works really well!
Only thing is that i cannot use it in background of some other excel work, there seems to be a conflict and its throwing a runtime error (9): see attached picture, is there a workaround for this? I already tried opening a separate Excel session, but did not solve.
Click to expand...

When you get the error, click the 'debug' button and tell us what line of code is highlighted.
 
Upvote 0
johnnyL said:
When you get the error, click the 'debug' button and tell us what line of code is highlighted.
Click to expand...
Of course, i tested again and got the error when one specific other workbook is open. See attached for the screenprint of the debug.
Also, it happened that the "TenMinuteUpdates" sheet was created in another workbook that happened to be open, is there a way to keep this in the same workbook (ie where the "Sheet1" table is)

thanks again :)
 

Attachments

  • Pic5.JPG
    Pic5.JPG
    124.8 KB · Views: 9
Upvote 0
See if this eliminates the problems you discussed:

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
 
Upvote 0
Solution
johnnyL said:
See if this eliminates the problems you discussed:

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
Click to expand...
Thanks man, running it as we speak - will keep you updated
 
Upvote 0
You must log in or register to reply here.

Similar threads

R
  • Solved
VBA Queries refresh and Save data as TXT
Replies
2
Views
451
Artik
Artik
A
  • Question Question
Office script in Excel instead of VBA
Replies
3
Views
362
6StringJazzer
6StringJazzer
J
  • Question Question
Split worksheets into separate excels AND only save those cells with data in them.
Replies
4
Views
391
mumps
mumps
A
  • Solved
Temporary sheet view not working
Replies
2
Views
111
ausswe
A
C
  • Question Question
Converting all of my Excel VBA library standard modules to class modules?
Replies
5
Views
418
RoryA
RoryA

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