asked on

Excel Alerts Part II

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

ASKER

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

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

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

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.

@rspahitz

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

ASKER

rspahitz/aikimark

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

ASKER

I'm checking it out now...

ASKER

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

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

ASKER

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

ASKER

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....

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.

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.

ASKER

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...

ASKER

At least 4, please mate.

ASKER

Are you still there chaps??

ASKER

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

ASKER

rspahitz

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

Lets wait and see what ssaqibh comes up with..

ASKER

rspahitz,

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

Cheers

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?

ASKER

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

ASKER CERTIFIED SOLUTION

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

ASKER

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

ASKER

Brilliant!