Pop up box based on certain values within cells

[rcbell90]

Hi,

I'm making some improvements to a spreadsheet and would like to add 2 different pop up boxes depending on what value is calculated in D-column.

With formulas:

Without formulas:

If =>1000, but <2000, then MsgBox "3C or SAP Ops must be completed".
If >2000, then MsgBox "PSA must be started".

I only want one pop up box of the two to appear, and the >2000 pop up box is first priority.
Id also like for no pop up box to appear if the value is <1000.

Please help, I've tried VBA coding and data validation methods but nothing has worked for me thus far.

Thank you,
Reece

 

[EXCEL MAX]

Hello rcbell90,
If you can do it as you want, try this...

1. In the "Formulas bar" turn on calculation option to "Automatic"
2. Open code editor
3. Select correct sheet in the left panel (Project Explorer)
4. Select "Calculate" event and insert this code

Option Explicit

Dim varNRows, varNLoop As Long
Dim varWorksheetName As String
Dim varColumn As Integer

Private Sub Worksheet_Calculate()
    
    varColumn = 4
    varWorksheetName = ActiveSheet.Name
    varNRows = Sheets(varWorksheetName).Cells(Rows.Count, 1).End(xlUp).Row
    For varNLoop = 2 To varNRows
        If Sheets(varWorksheetName).Cells(varNLoop, varColumn).Value > 1000 And _
            Sheets(varWorksheetName).Cells(varNLoop, varColumn).Value < 2000 Then
            MsgBox (Sheets(varWorksheetName).Cells(varNLoop, varColumn - 1).Value & _
                    " or SAP Ops must be completed")
            Exit Sub
        End If
        If Sheets(varWorksheetName).Cells(varNLoop, varColumn).Value > 2000 Then
             MsgBox ("PSA must be started")
            Exit Sub
        End If
    Next
    
End Sub

Now insert some formula in the column 4 and fill down.
Every time when formula calculate, then rises up specific message from code.

 

[EXCEL MAX]

If you want to add priority to ranges with values greater then 2000 then
change code to this...

   varColumn = 4
    varWorksheetName = ActiveSheet.Name
    varNRows = Sheets(varWorksheetName).Cells(Rows.Count, 1).End(xlUp).Row
    For varNLoop = 2 To varNRows
        If Sheets(varWorksheetName).Cells(varNLoop, varColumn).Value > 2000 Then
             Sheets(varWorksheetName).Cells(varNLoop, varColumn - 1).Select
             MsgBox ("Row " & Sheets(varWorksheetName).Cells(varNLoop, varColumn - 1).Row & _
                " X>2000 PSA must be started")
            
            Exit Sub
        End If
    Next
    For varNLoop = 2 To varNRows
        If Sheets(varWorksheetName).Cells(varNLoop, varColumn).Value >= 1000 And _
            Sheets(varWorksheetName).Cells(varNLoop, varColumn).Value < 2000 Then
            Sheets(varWorksheetName).Cells(varNLoop, varColumn - 1).Select
            MsgBox ("Row " & Sheets(varWorksheetName).Cells(varNLoop, varColumn - 1).Row & _
                    " 1000>X<2000 Ops must be completed")
            Exit Sub
        End If
    Next

 

[JoeMo]

Here's a change event macro for the sheet your data are in. It will automatically launch a MsgBox(es) whenever changes are made to columns A, B or C or any combination of cells in those columns, if your criteria are met. The change could be the result of a manual entry in a single cell or multiple entries done by a paste to multiple cells in those columns. Note that if you change cells in multiple rows with a single paste, each row that meets your criteria will result in a msgbox with the appropriate message.

To install sheet code:
1. Right-click the worksheet tab you want to apply it to and choose 'View Code'. This will open the VBE window.
2. Copy the code below from your browser window and paste it into the white space in the VBE window.
3. Close the VBE window and Save the workbook. If you are using Excel 2007 or a later version do a SaveAs and save it as a macro-enabled workbook (.xlsm file extension).
4. Make sure you have enabled macros whenever you open the file or the code will not run.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim R As Range, Rw As Range, ctH As Long, ctL As Long
Set R = Intersect(Range("A2:C" & Cells(Rows.Count, "A").End(xlUp).Row), Target)
If Not R Is Nothing Then
    Me.Calculate
    For Each Rw In R.Rows
        If Cells(Rw(1).Row, "D") >= 2000 Then
            ctH = ctH + 1
            Select Case ctH
                Case 1: MsgBox "PSA must be started": ctH = 0
                Case Else: ctH = 0
            End Select
        ElseIf Cells(Rw(1).Row, "D") >= 1000 Then
            ctL = ctL + 1
            Select Case ctL
                Case 1: MsgBox "3C or SAP Ops must be completed": ctL = 0
                Case Else: ctL = 0
            End Select
        End If
    Next Rw
End If
End Sub

 

[rcbell90]

Fantastic - works great.

Thank you guys