Excel Alerts Part II

cpatte7372
cpatte7372 used Ask the Experts™
on
Hello Experts,

An expert compiled the following formula which works perfectly.

Sub checkall()
Set ws = Sheets("mini sized DOW")
For Each rw In ws.Range("A3:A" & Range("B3").End(xlDown).Row)
For Each cel In Range("$AY$" & rw.Row & ":$AZ$" & rw.Row & ",$BB$" & rw.Row & ",$BD$" & rw.Row)
    For Each cf In cel.FormatConditions
        frmla = cf.Formula1
        frmla = Application.ConvertFormula(frmla, xlA1, xlR1C1, , cf.AppliesTo.Cells(1, 1))
        frmla = Application.ConvertFormula(frmla, xlR1C1, xlA1, , cel)
        If Evaluate(frmla) Then
            If cf.Interior.Color <> 5296274 Then stts = "": Exit For
            stts = "green"
            Exit For
        End If
    Next cf
    If stts <> "green" Then Exit For
Next cel
If stts = "green" Then cplist = cplist & rw.Cells(1, 2) & ", "
stts = ""
Next rw
MsgBox "All cells are green for" & vbCrLf & Left(cplist, Len(cplist) - 2)
End Sub

I was wondering if the same expert or another expert could tweak it for me so that the pop up message appears when four of the conditions appear rather than when each individual condition appears. At the moment, I need to manually run the macro and it will also appear whenever an individual condition occurs. I would like it automatically occur when four of the same conditions are currently occurring

I have attached the spreadsheet for illustration.
EEMINI-DOW.xlsm
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®

Author

Commented:
Experts,

Just to explain why I need an alert or pop-up when four rows are highlighted green. Each green highlight signifies that a lot of buyers are buying a particular stock in the 'Dow Jones 30', however I would need to know that at least four stocks are being bought before I enter into a trade.

Cheers

Commented:
Maybe this?

 
Sub checkall()
    Dim iCntr As Integer
    
    iCntr = 0
    Set ws = Sheets("mini sized DOW")
    For Each rw In ws.Range("A3:A" & Range("B3").End(xlDown).Row)
        For Each cel In Range("$AY$" & rw.Row & ":$AZ$" & rw.Row & ",$BB$" & rw.Row & ",$BD$" & rw.Row)
            For Each cf In cel.FormatConditions
                frmla = cf.Formula1
                frmla = Application.ConvertFormula(frmla, xlA1, xlR1C1, , cf.AppliesTo.Cells(1, 1))
                frmla = Application.ConvertFormula(frmla, xlR1C1, xlA1, , cel)
                If Evaluate(frmla) Then
                    If cf.Interior.Color <> 5296274 Then stts = "": Exit For
                    iCntr = iCntr + 1
                    If iCntr > 3 Then
                        stts = "green"
                    End If
                End If
            Next cf
            If stts <> "green" Then Exit For
        Next cel
        If stts = "green" Then cplist = cplist & rw.Cells(1, 2) & ", "
        stts = ""
    Next rw
    MsgBox "All cells are green for" & vbCrLf & Left(cplist, Len(cplist) - 2)
End Sub

Open in new window

Commented:
sorry...lost a line...try this:

 
Sub checkall()
    Dim iCntr As Integer
    
    iCntr = 0
    Set ws = Sheets("mini sized DOW")
    For Each rw In ws.Range("A3:A" & Range("B3").End(xlDown).Row)
        For Each cel In Range("$AY$" & rw.Row & ":$AZ$" & rw.Row & ",$BB$" & rw.Row & ",$BD$" & rw.Row)
            For Each cf In cel.FormatConditions
                frmla = cf.Formula1
                frmla = Application.ConvertFormula(frmla, xlA1, xlR1C1, , cf.AppliesTo.Cells(1, 1))
                frmla = Application.ConvertFormula(frmla, xlR1C1, xlA1, , cel)
                If Evaluate(frmla) Then
                    If cf.Interior.Color <> 5296274 Then stts = "": Exit For
                    iCntr = iCntr + 1
                    If iCntr > 3 Then
                        stts = "green"
                        Exit For
                    End If
                End If
            Next cf
            If stts <> "green" Then Exit For
        Next cel
        If stts = "green" Then cplist = cplist & rw.Cells(1, 2) & ", "
        stts = ""
    Next rw
    MsgBox "All cells are green for" & vbCrLf & Left(cplist, Len(cplist) - 2)
End Sub

Open in new window

Amazon Web Services

Are you thinking about creating an Amazon Web Services account for your business? Not sure where to start? In this course you’ll get an overview of the history of AWS and take a tour of their user interface.

Commented:
Looking a bit further, I guess you want it against the range...let me spend a few more minutes on it to get it right for you.
Top Expert 2014

Commented:
@rspahitz

Count the number of those conditions and the conditionally invoke the msgbox if count >3.

Author

Commented:
rspahitz/aikimark

Thanks for assisting me with this. I thought I was going to have ask your rivals at Excel Forum... :-)

Author

Commented:
I'm checking it out now...

Author

Commented:
Gents,

While I review your solution, I did ask for help elsewhere. The feedback I got was the attached illustration. However, it won't alert. When I asked the person to troubleshoot why it wouldn't alert he condition figure it out. I wonder if you can check it out??

Basically, you'll see for rows highlighted green. The test is to increase one of the numbers to a level when its not green e.g. increase BC3 to say 1000000000 to remove the green highlight and then lower it to 1000 in get a green highlight which will provide a pop up and a sound alert.

However, it won't work.....
EEMINI-DOWv2.xlsm

Commented:
OK,

I think this should handle it: only report those where all 4 cells in a row are green:

 
Sub checkall()
    Dim iCntr As Integer
    Dim ws As Worksheet
    Dim rw As Range
    Dim cel As Range
    Dim cf As FormatCondition
    Dim frmla As String
    Dim stts As String
    Dim cplist As String
    
    cplist = ""
    Set ws = Sheets("mini sized DOW")
    For Each rw In ws.Range("A3:A" & Range("B3").End(xlDown).Row)
        iCntr = 0
        For Each cel In Range("$AY$" & rw.Row & ":$AZ$" & rw.Row & ",$BB$" & rw.Row & ",$BD$" & rw.Row)
            For Each cf In cel.FormatConditions
                frmla = cf.Formula1
                frmla = Application.ConvertFormula(frmla, xlA1, xlR1C1, , cf.AppliesTo.Cells(1, 1))
                frmla = Application.ConvertFormula(frmla, xlR1C1, xlA1, , cel)
                If Evaluate(frmla) Then
                    If cf.Interior.Color <> 5296274 Then
                        stts = ""
                    Else
                        stts = "green"
                    End If
                    Exit For
                End If
            Next cf
            If stts = "green" Then
                iCntr = iCntr + 1
                If iCntr > 3 Then
                    Exit For
                End If
            Else
                Exit For
            End If
        Next cel
        If stts = "green" Then
            cplist = cplist & rw.Cells(1, 2) & ", "
        End If
        stts = ""
    Next rw
    MsgBox "All cells are green for" & vbCrLf & Left(cplist, Len(cplist) - 2)
End Sub

Open in new window

Author

Commented:
rspahitz

That is absolute genius....

Is it possible to for the macro to run without me calling it? Meaning that it will run when the condition occurs rather than me having to manually run the macro?

Cheers

Author

Commented:
Oops rspahitz,

I thought you nailed it with the final formula, however it works exactly the same way as the original formula I posted at he beginning of my request....

Commented:
Are you saying that you're getting more than 4 entries in the message box?
Are you running the code form 3 posts up?

And to run "by itself", it needs a trigger.  We could apply that to the following code in the current worksheet:


Private Sub Worksheet_Calculate()
   checkall
End Sub

However, if you do that, you may find that it impacts performance, depending on how often and how complex the changes are.
A better choice is to probably just add a button someone and click on it to launch the same process.
Let me know if you need help with that.

Commented:
Oh, and I see you have no formulas so the calculate event won't fire.  Instead you could have it here, every time you change the value of a cell:

Private Sub Worksheet_Change(ByVal Target As Range)
    checkall
End Sub

I think you'll quickly find that this is too much and may want to go with the button.

Author

Commented:
rspahitz,

I would ideally like it to track only when there are only four entries. At the moment, it will track if there are 4, 3, 2 or 1 entry, which is exactly what my original formula achieved.

However, more importantly I really would like the trigger as it conditions don't occur that often. Therefore, I really would appreciate further help.

Cheers mate.
cpatte7372, some clarifications.

Do you want it to trigger on

Exactly 4            4
At least 4           4, 5, 6...
multiples of 4     4, 8, 12...

Author

Commented:
At least 4,  please mate.

Author

Commented:
Are you still there chaps??

Author

Commented:
rspahitz

While we wait for ssaqibh, can you tell me where I would need to apply:


Private Sub Worksheet_Change(ByVal Target As Range)
    checkall
End Sub


Cheers

Author

Commented:
rspahitz

I see what you mean - its triggering all the time....

Lets wait and see what ssaqibh comes up with..

Author

Commented:
rspahitz,


I just had a thought. Is it possible to run macros at certain intervals? Lets say every 5mins?

Cheers

Commented:
You can have it run a timer, but I think it needs to run a Windows dll.  I'm not sure why MS didn't include a timer component in Excel since they have it in Access VBA.

What we can do is limit the scope of when the processing occurs, like only specific rows or columns.
We could also have it track how many cells have change and the amount of time that passed between changes and, for example, when you make a change, if more than 5 minutes passed then perform the review.

But back to my latest code, maybe I'm not understanding, but my message box shows this:

All cells are green for
YM #F, KO, DIS, MSFT

Are you getting something different?

Author

Commented:
Morning rspah

I am getting YM #F, KO, DIS, MSFT, however I would like it appear only if all four turn green. At the moment even if DIS turned green I would get the pop up.

Cheers

Author

Commented:
ssaqibh,

I don't wanna get too excited (I've often been a little quick saying 'job done', before really doing any testing) but I think this is it... I need to carry out some further tests but on the face of it I think you've nailed it mate....


That is bloody brilliant. If it continues to work as it working now, I really won't know how to thank you....
You are very right. Just take your time and make sure you have not left something out.

Saqib

Author

Commented:
Brilliant!

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial