If R6 > 149.99 Then

D

data808

Active Member
Joined
Dec 3, 2010
Messages
356
Office Version
  1. 2019
Platform
  1. Windows
I have a R6 cell that when the user goes over 149.99 or more than it will show them a message box. However, how do I prevent it from showing once they hit 150? If the user continues to go up in numbers it will keep popping up the message box but I would only like it to show them one time once they hit their 150 quota. Here is the code I have so far:

If [R6] > "149.99" Then
MsgBox "Congratulations!!!" & vbNewLine & vbNewLine & _
"You have made your quota for the day!" & vbNewLine & _
"Time to chillax..."
End If
 
Sort by date Sort by votes
I just realised that you said R6 is a formula and dependent on K99.
That means that R6 will never trigger the change event. What are the underlying "input cells" that flow through to R6 ?
We need to change the line below so that Range("R6") is replaced with the cell or range of cells that are manually being updated and causing R6 to change.
If Not Intersect(Target, Range("R6")) Is Nothing
 
Upvote 0

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"
Alex Blakenburg said:
I just realised that you said R6 is a formula and dependent on K99.
That means that R6 will never trigger the change event. What are the underlying "input cells" that flow through to R6 ?
We need to change the line below so that Range("R6") is replaced with the cell or range of cells that are manually being updated and causing R6 to change.
If Not Intersect(Target, Range("R6")) Is Nothing
Click to expand...
Well not how deep you want me to dig but here's a start:

R6 and R7 =CONCATENATE(K99)*1 or I can just change this to =K99 to simplify it. It would reflect the same thing.

K99 =SUM(K94:K98)

K94 = I94*J94
K95 = I95*J95
K96 = I96*J96
K97 = I97*J97
K98 = I98*J98

I94 = SUM(SUMIF(C8:C88,103,I8:I88),SUMIF(C8:C88,104,I8:I88))
J94 = 0.43
I95 = I89-I94
J95 = 0.57
 
Upvote 0
This is a bit of a science expirement but try the below.
Add the red code to your code in the positions indicated.
If you are not using the words "Option Explicit" just put the Public gPrevAchieved line at the very start of the Sheet module.

Rich (BB code): 
Option Explicit

Public gPrevAchieved As Variant

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    ' ---- Quota message box section ----
    Application.EnableEvents = False
    If gPrevAchieved = "" Then
        'If Not Intersect(Target, Range("R6")) Is Nothing
        If Target.Cells.Count = 1 _
                And IsNumeric(Range("R6")) Then
            Application.EnableEvents = False
            Application.Undo    ' Get previous value
            gPrevAchieved = Range("R6").Value
            Application.Undo    ' Restore current value
        End If
    End If

    If IsNumeric(Range("R6")) And gPrevAchieved < 150 And Target.Value > 149.99 Then
        MsgBox "Congratulations!!!" & vbNewLine & vbNewLine & _
                "You have made your quota for the day!" & vbNewLine & _
                "Time to chillax..."
    End If
    Application.EnableEvents = True
    ' ---- End of Quota message box section ----


' type in columns A-C to do a time stamp in column D. also capital HH:MM is for military time. hh:mm would be _
regular time so you could include am/pm. Example "hh:mm am/pm"
    With Target
        If .Count > 1 Then Exit Sub
 
Upvote 0
Alex Blakenburg said:
This is a bit of a science expirement but try the below.
Add the red code to your code in the positions indicated.
If you are not using the words "Option Explicit" just put the Public gPrevAchieved line at the very start of the Sheet module.

Rich (BB code): 
Option Explicit

Public gPrevAchieved As Variant

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    ' ---- Quota message box section ----
    Application.EnableEvents = False
    If gPrevAchieved = "" Then
        'If Not Intersect(Target, Range("R6")) Is Nothing
        If Target.Cells.Count = 1 _
                And IsNumeric(Range("R6")) Then
            Application.EnableEvents = False
            Application.Undo    ' Get previous value
            gPrevAchieved = Range("R6").Value
            Application.Undo    ' Restore current value
        End If
    End If

    If IsNumeric(Range("R6")) And gPrevAchieved < 150 And Target.Value > 149.99 Then
        MsgBox "Congratulations!!!" & vbNewLine & vbNewLine & _
                "You have made your quota for the day!" & vbNewLine & _
                "Time to chillax..."
    End If
    Application.EnableEvents = True
    ' ---- End of Quota message box section ----


' type in columns A-C to do a time stamp in column D. also capital HH:MM is for military time. hh:mm would be _
regular time so you could include am/pm. Example "hh:mm am/pm"
    With Target
        If .Count > 1 Then Exit Sub
Click to expand...
Thanks for the reply. Sorry for the delay. Only had time to test this out now. It appears to be doing some things right. So I notice if I enter a value 150 or more it will trigger the msgbox. However, the user will never enter 150 or more at a time. It will be an accumulation of values usually 50 or less throughout the day that should add up to 150 or more by the end of the day which would be there quota. It will also trigger more than once if I keep entering 150 or more which I would want it to only show the msgbox on the first time they hit 150 and never again. They may work past there quota and go into the 200 values but I wouldn't want that msgbox to pop up for every entry after 150. So basically right now, it only functions if I enter 150 or more on a single entry. It does not work if I enter smaller values and eventually adding up to 150. Also got an error message when I deleted multiple cell values typed in by the user. The error message was: Run-time error '13': Type mismatch. If I delete a cell value that the user typed in one by one then the error message does not appear. Let me know if you need any other info. Thank you.
 
Upvote 0
OK try the below:
Note: for trouble shooting purposes if you have any VBA error you need to provide the Line that is highlighted when you hit debug as well as the giving the error message, otherwise it is almost impossible to provide a fix for the issue.

VBA Code: 
    Application.EnableEvents = False
    If IsNumeric(Range("R6")) Then
        If gPrevAchieved = "" Then
            Application.EnableEvents = False
            Application.Undo    ' Get previous value
            gPrevAchieved = Range("R6").Value
            Application.Undo    ' Restore current value
        End If
        
        If gPrevAchieved <> Range("R6") Then
            If gPrevAchieved < 150 And Range("R6") > 149.99 Then
                gPrevAchieved = Range("R6").Value
                MsgBox "Congratulations!!!" & vbNewLine & vbNewLine & _
                        "You have made your quota for the day!" & vbNewLine & _
                        "Time to chillax..."
            Else
                gPrevAchieved = Range("R6").Value
            End If
        End If
    End If
        
    Application.EnableEvents = True
    ' ---- End of Quota message box section ----
 
Last edited:
Upvote 0
Alex Blakenburg said:
OK try the below:
Note: for trouble shooting purposes if you have any VBA error you need to provide the Line that is highlighted when you hit debug as well as the giving the error message, otherwise it is almost impossible to provide a fix for the issue.

VBA Code: 
    Application.EnableEvents = False
    If IsNumeric(Range("R6")) Then
        If gPrevAchieved = "" Then
            Application.EnableEvents = False
            Application.Undo    ' Get previous value
            gPrevAchieved = Range("R6").Value
            Application.Undo    ' Restore current value
        End If
       
        If gPrevAchieved <> Range("R6") Then
            If gPrevAchieved < 150 And Range("R6") > 149.99 Then
                gPrevAchieved = Range("R6").Value
                MsgBox "Congratulations!!!" & vbNewLine & vbNewLine & _
                        "You have made your quota for the day!" & vbNewLine & _
                        "Time to chillax..."
            Else
                gPrevAchieved = Range("R6").Value
            End If
        End If
    End If
       
    Application.EnableEvents = True
    ' ---- End of Quota message box section ----
Click to expand...
Thanks. Sorry I actually meant to give you the debug highlighted line but must have forgot to copy and paste it into my post. Thanks again. Will test this out and get back to you.
 
Upvote 0
data808 said:
Thanks. Sorry I actually meant to give you the debug highlighted line but must have forgot to copy and paste it into my post. Thanks again. Will test this out and get back to you.
Click to expand...
Just pasted your last code and got an error message:

Run-time error '1004':
Method 'Range' of object '_Global' failed

This time debug is grayed out and not available for me to click on it. Here is what the code looks like in the change event:

VBA Code: 
Public gPrevAchieved As Variant

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    ' ---- Quota message box section ----
    Application.EnableEvents = False
    If IsNumeric(Range("R6")) Then
        If gPrevAchieved = "" Then
            Application.EnableEvents = False
            Application.Undo    ' Get previous value
            gPrevAchieved = Range("R6").Value
            Application.Undo    ' Restore current value
        End If
        
        If gPrevAchieved <> Range("R6") Then
            If gPrevAchieved < 150 And Range("R6") > 149.99 Then
                gPrevAchieved = Range("R6").Value
                MsgBox "Congratulations!!!" & vbNewLine & vbNewLine & _
                        "You have made your quota for the day!" & vbNewLine & _
                        "Time to chillax..."
            Else
                gPrevAchieved = Range("R6").Value
            End If
        End If
    End If
        
    Application.EnableEvents = True
    ' ---- End of Quota message box section ----


' type in columns A-C to do a time stamp in column D. also capital HH:MM is for military time. hh:mm would be
' regular time so you could include am/pm. Example "hh:mm am/pm"
    With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Range("A:C"), .Cells) Is Nothing Then
        Application.EnableEvents = False
        With Range("D" & Target.Row)
            If Not IsDate(.Value) Then
                .NumberFormat = "HH:MM"
                .Value = Now
            End If
        End With
        Application.EnableEvents = True
        End If
    End With
' same as above but different range and target
        With Target
        If .Count > 1 Then Exit Sub
        If Not Intersect(Range("F:O"), .Cells) Is Nothing Then
        Application.EnableEvents = False
        With Range("E" & Target.Row)
            If Not IsDate(.Value) Then
                .NumberFormat = "HH:MM"
                .Value = Now
            End If
        End With
        Application.EnableEvents = True
        End If
    End With
' takes first 3 characters from the drop down list in column C. drop down list was done by data validation
    If Not Intersect(Target, Range("C8:C88")) Is Nothing And Target.CountLarge = 1 Then
        Application.EnableEvents = False
        Target = Left(Target, 3)
        Application.EnableEvents = True
    End If
    
End Sub
 
Upvote 0
Firstly can you put your cursor inside the code and go Debug > Compile VBA project.
Does that show up any errors ?

If not put a breakpoint on the Application.Screenupdating (by clicking in the margin next to the line)
Change a value in the spreadsheet that will change R6.
It should trigger the code and stop at the breakpoint.
Then F8 through the code and see where it goes and if it errors out.
 
Upvote 0
Alex Blakenburg said:
Firstly can you put your cursor inside the code and go Debug > Compile VBA project.
Does that show up any errors ?

If not put a breakpoint on the Application.Screenupdating (by clicking in the margin next to the line)
Change a value in the spreadsheet that will change R6.
It should trigger the code and stop at the breakpoint.
Then F8 through the code and see where it goes and if it errors out.
Click to expand...
Alex Blakenburg said:
Firstly can you put your cursor inside the code and go Debug > Compile VBA project.
Does that show up any errors ?

If not put a breakpoint on the Application.Screenupdating (by clicking in the margin next to the line)
Change a value in the spreadsheet that will change R6.
It should trigger the code and stop at the breakpoint.
Then F8 through the code and see where it goes and if it errors out.
Click to expand...
Thanks. I did the Debug and compile VBA project with nothing happening. Not sure how to do the next part that you asked me to do. Where is Application.Screenupdating? Is the margin you are referring to on the left side of the VBA window? Like where the scroll bar would be but on the opposite side?
 
Upvote 0
Alex Blakenburg said:
Firstly can you put your cursor inside the code and go Debug > Compile VBA project.
Does that show up any errors ?

If not put a breakpoint on the Application.Screenupdating (by clicking in the margin next to the line)
Change a value in the spreadsheet that will change R6.
It should trigger the code and stop at the breakpoint.
Then F8 through the code and see where it goes and if it errors out.
Click to expand...
Oh I got it to work but I had to deactivate this with an apostrophe:

Private Sub Workbook_Activate()

bFlashing = False
' dblPreVal = Range(FLASHING_CELL)
End Sub

Then I also had to add the On Error Resume Next line which I know is bad but it worked after I added it. So now the code for the Workbook_SheeCalculate looks like this:

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
On Error Resume Next
If Sh Is Range(FLASHING_CELL).Parent Then
With Range(FLASHING_CELL)
If VarType(.Value) = vbDouble Then
Select Case True
Case (.Value >= PEAK_VALUE) And (dblPreVal < PEAK_VALUE) And bFlashing = False
Call FlashCell(Range(FLASHING_CELL), vbGreen)
Case (.Value < PEAK_VALUE) And (dblPreVal >= PEAK_VALUE) And bFlashing = False
Call FlashCell(Range(FLASHING_CELL), vbRed)
End Select
dblPreVal = .Value
End If
End With
End If
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Macro not saving exported files to where it should
Replies
2
Views
271
shand
S
Y
  • Solved
Combo Boxes in User Form Keep repeating the options as I clear Them with Command Button
2
Replies
11
Views
152
dmt32
D
T
  • Question
Web query basics
2
Replies
13
Views
302
Domenic
D
D
  • Question
VBA Loop Through Named Ranges
Replies
1
Views
210
Jeffrey Mahoney
Jeffrey Mahoney
C
  • Solved
Make Message Box Only Appear Once
Replies
6
Views
194
Joe4
Joe4

Forum statistics

Threads
1,216,105
Messages
6,128,859
Members
449,472
Latest member
ebc9

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