message box on private worksheet sub loops

M

MarkRush

New Member
Joined
Mar 6, 2018
Messages
28
so I am trying my first private worksheet macro and having a problem with my second statement . if the 1st test passes everything works great. if the second test fails the message box just keeps repeating


Code: 
Private Sub Worksheet_Change(ByVal Target As Range) 
If Range("b5") = "Loyalty2gether" And Range("S5") > Range("S6") Then  [COLOR=#ff0000]( if this condition is met,works great message box pops up and macro stops)[/COLOR]
 
    MsgBox "your quote does not qualify for the Loyalty2gether Promotion"
    
    Range("b5").Value = "SBA Type"
    Range("b7").Value = "Quantity of discounted 9608G phones cannot exceed total or core and power licenses"
 


    ElseIf Range("b5") = "Loyalty2gether" And Range("S6") > Range("S5") Then ([COLOR=#ff0000]if this condition is met,  the message box repeats completely and I need to control -break to stop)[/COLOR]
 
    MsgBox "Your quote does  qualify for the Loyalty2gether Promotion"
    
    
    Range("B7").Value = "blah blah blah"[COLOR=#ff0000]( if i select debug after control -break, this row gets highlighted)[/COLOR]
    
    End If
    
End Sub

Ideally I need multiple elseif statements for multiples tests like this :

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 'popup if9608 greater thancore and powerusers
If Range("b5") = "Loyalty2gether" And Range("S5") > Range("S6") Then
 
    MsgBox "your quote does not qualify for the Loyalty2gether Promotion"
    
    Range("b5").Value = "SBA Type"
    Range("b7").Value = "Quantity of discounted 9608G phones cannot exceed total or core and power licenses"
 


    ElseIf Range("b5") = "Loyalty2gether" And Range("S6") > Range("S5") Then
 
    MsgBox "Your quote does  qualify for the Loyalty2gether Promotion"
    
    
    Range("B7").Value = "blah blah blah"
    
 ElseIf Range("b5") = "Now" And Range("S7") > Range("S8") Then
 
     MsgBox "Your quote does  qualify for the Now Promotion"
    
    
    Range("B7").Value = "blah blah blah1"

 ElseIf Range("b5") = "Now" And Range("S7") < Range("S8") Then
 
     MsgBox "Your quote does not qualify for the Now Promotion"
    
    
    Range("B7").Value = "blah blah blah2"



    End If
    
End Sub

thanks in advance for any help
 

Excel Facts

Copy formula down without changing references
If you have =SUM(F2:F49) in F50; type Alt+' in F51 to copy =SUM(F2:F49) to F51, leaving the formula in edit mode. Change SUM to COUNT.
Sort by date Sort by votes
Firstly, because you are changing cell values the code is likely to loop permanently. try
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Range("b5") = "Loyalty2gether" And Range("S5") > Range("S6") Then
 
    MsgBox "your quote does not qualify for the Loyalty2gether Promotion"
    
    Range("b5").Value = "SBA Type"
    Range("b7").Value = "Quantity of discounted 9608G phones cannot exceed total or core and power licenses"
 


    ElseIf Range("b5") = "Loyalty2gether" And Range("S6") > Range("S5") Then
 
    MsgBox "Your quote does  qualify for the Loyalty2gether Promotion"
    
    
    Range("B7").Value = "blah blah blah"
    
    End If
Application.EnableEvents = True

End Sub
Secondly Do you only want the event to work if you change the values in B5 & B7?
 
Upvote 0
"Secondly Do you only want the event to work if you change the values in B5 & B7
Click to expand...

B5 is a drop down list box, B7 will only be changed by the macro..

thinking thru this, I will probably protect the sheet and have every cell locked, except B5 and add an unprotect /protect statement at beginning and end of macro

I will try your modifications shortly thanks
 
Upvote 0
ok, how about this
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
   If Target.CountLarge > 1 Then Exit Sub
   If Not Target = Range("B5") Then Exit Sub
Application.EnableEvents = False
   If Target.Value = "Loyalty2gether" And Range("S5") > Range("S6") Then
      MsgBox "your quote does not qualify for the Loyalty2gether Promotion"
      Target.Value = "SBA Type"
      Range("b7").Value = "Quantity of discounted 9608G phones cannot exceed total or core and power licenses"
   ElseIf Target.Value = "Loyalty2gether" And Range("S6") > Range("S5") Then
      MsgBox "Your quote does  qualify for the Loyalty2gether Promotion"
      Range("B7").Value = "blah blah blah"
   ElseIf Target.Value = "Now" And Range("S7") > Range("S8") Then
      MsgBox "Your quote does  qualify for the Now Promotion"
      Range("B7").Value = "blah blah blah1"
   ElseIf Target.Value = "Now" And Range("S7") < Range("S8") Then
      MsgBox "Your quote does not qualify for the Now Promotion"
      Range("B7").Value = "blah blah blah2"
   End If
Application.EnableEvents = True
End Sub
 
Upvote 0
so I built it this way and it worked , worked great.


Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 'used to verify promotions
Application.EnableEvents = False
    If Range("b5") = "Loyalty2gether" And Range("S5") > Range("S6") Then
            MsgBox "your quote does not qualify for the Loyalty2gether Promotion"
            Range("b5").Value = "SBA Type"
            Range("b7").Value = "Quantity of discounted 9608G phones cannot exceed total or core and power licenses"
    ElseIf Range("b5") = "Loyalty2gether" And Range("S5") < Range("S6") Or Range("S6") = Range("S5") Then
            MsgBox "Your quote does  qualify for the Loyalty2gether Promotion, please submit via final quote process for Avaya approval"
            Range("B7").Value = "Your quote does  qualify for the Loyalty2gether Promotion, please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "NOW greenfield" And Range("AA5") > Range("AA7") Then
            MsgBox "Your quote does not qualify for the xCaaS Now Promotion"
            Range("b5").Value = "SBA Type"
            Range("B7").Value = "Phones exceed 105% of licenses"
    ElseIf Range("b5") = "NOW greenfield" And Range("AA5") < Range("AA7") Or Range("AA5") = Range("AA7") Then
            MsgBox "Your quote does  qualify for the xCaaS Now Promotion please submit via final quote process for Avaya approval"
            Range("B7").Value = "Now Greenfied applied,Please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "NOW SA" And Range("AA5") > Range("AA7") Then
            MsgBox "Your quote does not qualify for the Now SA Promotion"
            Range("b5").Value = "SBA Type"
            Range("B7").Value = "Phones exceed 105% of licenses"
    ElseIf Range("b5") = "NOW SA" And Range("AA5") < Range("AA7") Or Range("AA5") = Range("AA7") Then
            MsgBox "Your quote does  qualify for the xCaaS Now Promotion please submit via final quote process for Avaya approval"
            Range("B7").Value = "xCaaS Now SA applied,Please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "NOW UA" And Range("AA5") > Range("AA7") Then
            MsgBox "Your quote does not qualify for the Now UA Promotion"
            Range("b5").Value = "SBA Type"
            Range("B7").Value = "Phones exceed 105% of licenses"
    ElseIf Range("b5") = "NOW UA" And Range("AA5") < Range("AA7") Or Range("AA5") = Range("AA7") Then
            MsgBox "Your quote does  qualify for the xCaaS UA Promotion please submit via final quote process for Avaya approval"
            Range("B7").Value = "xCaaS Now UA applied,Please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "Custom" Then
            MsgBox "please submit your quote to the DE pool for configuration and submittal to Avaya"
            Range("B7").Value = "No Promotion Applied, please submit to DE pool for Configuration"
    ElseIf Range("b5") = "STANDARD RATE CARD" Then
            MsgBox "STANDARD RATE CARD APPLIED"
            Range("B7").Value = "STANDARD RATE CARD "
    End If
Application.EnableEvents = True
End Sub

So I then went and protected the sheet so that all cells except b5 were locked and changed the code to this

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
 'used to verify promotions
 With Sheets("Promotions")
.Unprotect Password:="Blue"
Application.EnableEvents = False
    If Range("b5") = "Loyalty2gether" And Range("S5") > Range("S6") Then
            MsgBox "your quote does not qualify for the Loyalty2gether Promotion"
            Range("b5").Value = "SBA Type"
            Range("b7").Value = "Quantity of discounted 9608G phones cannot exceed total or core and power licenses"
    ElseIf Range("b5") = "Loyalty2gether" And Range("S5") < Range("S6") Or Range("S6") = Range("S5") Then
            MsgBox "Your quote does  qualify for the Loyalty2gether Promotion, please submit via final quote process for Avaya approval"
            Range("B7").Value = "Your quote does  qualify for the Loyalty2gether Promotion, please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "NOW greenfield" And Range("AA5") > Range("AA7") Then
            MsgBox "Your quote does not qualify for the xCaaS Now Promotion"
            Range("b5").Value = "SBA Type"
            Range("B7").Value = "Phones exceed 105% of licenses"
    ElseIf Range("b5") = "NOW greenfield" And Range("AA5") < Range("AA7") Or Range("AA5") = Range("AA7") Then
            MsgBox "Your quote does  qualify for the xCaaS Now Promotion please submit via final quote process for Avaya approval"
            Range("B7").Value = "Now Greenfied applied,Please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "NOW SA" And Range("AA5") > Range("AA7") Then
            MsgBox "Your quote does not qualify for the Now SA Promotion"
            Range("b5").Value = "SBA Type"
            Range("B7").Value = "Phones exceed 105% of licenses"
    ElseIf Range("b5") = "NOW SA" And Range("AA5") < Range("AA7") Or Range("AA5") = Range("AA7") Then
            MsgBox "Your quote does  qualify for the xCaaS Now Promotion please submit via final quote process for Avaya approval"
            Range("B7").Value = "xCaaS Now SA applied,Please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "NOW UA" And Range("AA5") > Range("AA7") Then
            MsgBox "Your quote does not qualify for the Now UA Promotion"
            Range("b5").Value = "SBA Type"
            Range("B7").Value = "Phones exceed 105% of licenses"
    ElseIf Range("b5") = "NOW UA" And Range("AA5") < Range("AA7") Or Range("AA5") = Range("AA7") Then
            MsgBox "Your quote does  qualify for the xCaaS UA Promotion please submit via final quote process for Avaya approval"
            Range("B7").Value = "xCaaS Now UA applied,Please submit via final quote process for Avaya approval"
    ElseIf Range("b5") = "Custom" Then
            MsgBox "please submit your quote to the DE pool for configuration and submittal to Avaya"
            Range("B7").Value = "No Promotion Applied, please submit to DE pool for Configuration"
    ElseIf Range("b5") = "STANDARD RATE CARD" Then
            MsgBox "STANDARD RATE CARD APPLIED"
            Range("B7").Value = "STANDARD RATE CARD "
    End If
Application.EnableEvents = True
.Protect Password:="Blue", AllowFormattingCells:="true", AllowFormattingColumns:="true"
End Sub

and it stopped working.. I removed the unprotect/protect code and it still doesnt work ! when i change cell b5 nothing happens.. no popup, no values changed.. It doesnt appear to be stuck in a loop, i can go to tother pages and call other macros.. it just doesnt seem to be activating on a cell change
 
Last edited:
Upvote 0
Try running this & see if that helps
Code: 
Sub chk()
Application.EnableEvents = True
End Sub
 
Upvote 0
You need an End With line before the end sub

Also, run Fluff's little subroutine once (it re-enables the event handler for your code to be active again).
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

Z
  • Question Question
VBA: Pass Args back to Sub from PVT Sub
Replies
4
Views
170
Skyybot
Skyybot
Rob_010101
  • Solved
Add message box
Replies
4
Views
503
Joe4
Joe4
H
  • Solved
VBA - Combine Multiple Message Box into a single box
2
Replies
11
Views
1K
Joe4
Joe4
H
  • Solved
Private sub to generate Message Box
Replies
5
Views
535
Jaafar Tribak
Jaafar Tribak
TheWaterDog
  • Solved
MsgBox - vbNo does not exit sub
Replies
2
Views
481
TheWaterDog
TheWaterDog

Forum statistics

Threads
1,224,824
Messages
6,181,187
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

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