Workbook_SheetChange, continues to loop with a Case Statement

RealtorScott · Jan 24th 2018

Hello,

I hope I am posting this in the right area.

I am using Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) and a Case Statement that looks for a cell change, that calls a macro based on the value.
I originally started out with the MsgBox Function to get all the case statements setup, to later add the macro's. It worked fine until I added the first macro.
It calls the macro fine, but it keeps repeating the If statement: MsgBox("Email the Buyer?", vbYesNo) , until I select No. Otherwise each time I select yes, it runs the macro over and over again until I select No.

All the MsgBox functions work fine and i thought it would be easy enough to just go back through and replace the MsgBox Okay Then!, with a Call statement to a Macro.

Can someone please show me the error of my ways?

Thanking you in advance for your time.

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


Select Case Range("CC26")
    
    Case "Email the Buyer"
    If MsgBox("Email the Buyer?", vbYesNo) = vbYes Then
    Call BuyerEmailsGeneral
   ' MsgBox "okay then!"
    End If
    Range("CC26").Value = "Click here to generate a new email"
          
    Case "Email the Seller"
    If MsgBox("Email the Seller", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("CC26").Value = "Click here to generate a new email"
    
    Case "Email the Other Agent"
    If MsgBox("Email the Other Agent", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc26").Value = "Click here to generate a new email"
    
    
    End Select

Display More

Mumps · Jan 24th 2018

Try this macro although I tried your original and it worked properly for me.

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    If Intersect(Target, Range("CC226")) Is Nothing Then Exit Sub
    Select Case Range("CC226")
        Case "Email the Buyer"
            If MsgBox("Email the Buyer?", vbYesNo) = vbYes Then
                Call BuyerEmailsGeneral
                'MsgBox "Buyer"
            End If
            Range("CC226").Value = "Click here to generate a new email"
            Exit Sub
        Case "Email the Seller"
            If MsgBox("Email the Seller", vbYesNo) = vbYes Then
                MsgBox "Seller"
            End If
            Range("CC226").Value = "Click here to generate a new email"
            Exit Sub
        Case "Email the Other Agent"
            If MsgBox("Email the Other Agent", vbYesNo) = vbYes Then
                MsgBox "Agent"
            End If
            Range("CC226").Value = "Click here to generate a new email"
            Exit Sub
    End Select
End Sub

Display More

RealtorScott · Jan 25th 2018

Thanks Mumps, But nothing runs at all when I add the code. I have attached the file if that helps. You will need to select the drop down in cell CC226 on the "New Master Sheet" tab and select "Email the Buyer" to see what happens, all the other Drop down items seem to work with the MsgBox functions. Also the code is in the ThisWorkbook module (but you probably already knew that).
Thanks for your help.

Mumps · Jan 25th 2018

Place your code between the EnableEvents lines like this:

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
       Application.EnableEvents = False
      'Your code here
      Application.EnableEvents = True
End Sub

This should stop the macro from returning to the beginning of the code to run it repeatedly.

RealtorScott · Jan 25th 2018

I'm sorry,

When I add the code as suggested nothing runs. Here is the code placed as suggested(unless I'm missing something).

Code

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


   Application.EnableEvents = False


    Select Case Range("CC26")
    
    Case "Email the Buyer"
    If MsgBox("Email the Buyer?", vbYesNo) = vbYes Then
    Call BuyerEmailsGeneral
   ' MsgBox "okay then!"
    End If
    Range("CC26").Value = "Click here to generate a new email"
            
    Case "Email the Seller"
    If MsgBox("Email the Seller", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("CC26").Value = "Click here to generate a new email"
    
    Case "Email the Other Agent"
    If MsgBox("Email the Other Agent", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc26").Value = "Click here to generate a new email"
    
        Case "Email the Lender"
    If MsgBox("Email the Lender", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc26").Value = "Click here to generate a new email"
    
    Case "Email our Title Company"
    If MsgBox("Email our Title Company", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc26").Value = "Click here to generate a new email"
    
    Case "Email the Other Title Co."
    If MsgBox("Email the Other Title Co.", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc26").Value = "Click here to generate a new email"
    
    Case "Email the Lender & Our Title Co."
    If MsgBox("Email the Lender & Our Title Co.", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc26").Value = "Click here to generate a new email"
    
    Case "Email the Lender, Title Companies & other Agent"
    If MsgBox("Email the Lender, Title Companies & other Agent", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc26").Value = "Click here to generate a new email"
        
    End Select
'================================================================================


Select Case Range("CC27")
    
 ' --This Case works with the active sheet Edit and Add Buyer Seller Emails
    
    Case "Edit or Add Buyer Emails"
    
    Range("CC27").Value = "Click here to add or edit boiler plate emails"
    If MsgBox("Edit or Add Buyer Emails?", vbYesNo) = vbYes Then
    Sheets("BuyerEmails").Visible = True
    Worksheets("BuyerEmails").Activate
    ActiveSheet.Range("H147").Select
    Application.GoTo Range("H147"), True
    End If
    
       
    Case "Edit or Add Seller Emails"
    Range("CC27").Value = "Click here to add or edit boiler plate emails"
    If MsgBox("Edit or Add Seller Emails?", vbYesNo) = vbYes Then
    Sheets("SellerEmails").Visible = True
    Worksheets("SellerEmails").Activate
    ActiveSheet.Range("H147").Select
    Application.GoTo Range("H147"), True
    End If
    
        
    Case "Edit or Add Lender Emails"
    Range("CC27").Value = "Click here to add or edit boiler plate emails"
    If MsgBox("Edit or Add Lender Emails?", vbYesNo) = vbYes Then
    Sheets("LenderEmails").Visible = True
    Worksheets("LenderEmails").Activate
    ActiveSheet.Range("H147").Select
    Application.GoTo Range("H147"), True
    End If
        
        
    Case "Edit or Add Other Agent Emails"
    Range("CC27").Value = "Click here to add or edit boiler plate emails"
    If MsgBox("Edit or Add Other Agent Emails?", vbYesNo) = vbYes Then
    Sheets("OtherAgentEmails").Visible = True
    Worksheets("OtherAgentEmails").Activate
    ActiveSheet.Range("H147").Select
    Application.GoTo Range("H147"), True
    End If
        
        
    Case "Edit or Add Title Co Emails"
    Range("CC27").Value = "Click here to add or edit boiler plate emails"
    If MsgBox("Edit or Add Title Co Emails?", vbYesNo) = vbYes Then
    Sheets("TitleCoEmails").Visible = True
    Worksheets("TitleCoEmails").Activate
    ActiveSheet.Range("H147").Select
    Application.GoTo Range("H147"), True
    End If
          
 
    End Select


    '=============================================================================
    
    Select Case Range("CC32")
    ' --This Case works with the active shhet to Add or Edit Vendors
    
    Case "Edit or Add Title Companies"
    Range("CC32").Value = "Click here to add or Edit Vendors"
    If MsgBox("Edit or Add Title Companies???", vbYesNo) = vbYes Then
    Sheets("Vendor Information").Visible = True
    Worksheets("Vendor Information").Activate
    ActiveSheet.Range("K46").Select
    Application.GoTo Range("k46"), True
    End If
 
        
    Case "Edit or Add Mortgage Companies"
    Range("CC32").Value = "Click here to add or Edit Vendors"
    If MsgBox("Edit or Add Mortgage Companies", vbYesNo) = vbYes Then
    Sheets("Vendor Information").Visible = True
    Worksheets("Vendor Information").Activate
    ActiveSheet.Range("K146").Select
    Application.GoTo Range("k146"), True
    End If
    
    
    Case "Edit or Add Survey Companies"
    Range("cc32").Value = "Click here to add or Edit Vendors"
    If MsgBox("Edit or Add Survey Companies", vbYesNo) = vbYes Then
    MsgBox "I'm Sorry, This feature is not setup yet!"
    End If
    
    
        Case "??"
    If MsgBox("??", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc32").Value = "Click here to add or Edit Vendors"
    
    Case "??"
    If MsgBox("??", vbYesNo) = vbYes Then
    MsgBox "okay then!"
    End If
    Range("cc32").Value = "Click here to add or Edit Vendors"
       
    End Select
    
Application.EnableEvents = True


End Sub

Display More

RealtorScott · Jan 25th 2018

Wait a minute! It appears to be working.
I will test further and get back. Thanks Mumps.

Mumps · Jan 25th 2018

My pleasure.

RealtorScott · Jan 25th 2018

Okay, that took care of the macro returning to the beginning of the code on that one, now I have a MsgBox that does not stop the code from running when "No" is selected. Is this the same problem?

So the buyer general email calls the CopySaleInfoToBuyerEmailsSheet() macor which shows a MsgBox that allows the user to abort the rest of the code. However when the user selects "No" the code runs anyway?
(This mesage box used to work).

Am I running into the same problem?

Please advise.

Thank you.

Code

Sub CopySaleInfoToBuyerEmailsSheet()


' This macro copies the current sale information starting from the Active worksheet
'    to the "Emails" worksheet to start an email


If MsgBox("Warning!!!  You have to run this macro from an active 'Sale Sheet'." & vbCrLf & "Would you like to Continue?" & vbCrLf & "Select 'Yes' or 'No' to continue", vbYesNo + vbCritical, "Selection") = vbNo Then Exit Sub
    
    Range("AJ32:BT160").Copy
    Sheets("BuyerEmails").Range("H10:BT138").PasteSpecial Paste:=xlPasteValues, Transpose:=False
    
End Sub

Display More

Code

Sub BuyerEmailsGeneral()


' This email is sent to:


'Dim sourceSheet As Worksheet
'Set sourceSheet = ActiveSheet


Call CopySaleInfoToBuyerEmailsSheet


Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngCc As Range
Dim rngBCC As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim StrSignature As String
'StrSignature = GetSignature(Environ("Userprofile") & "\AppData\Roaming\Microsoft\Signatures\Default.htm")


Set objOutlook = CreateObject("Outlook.Application")
Set objMail = objOutlook.CreateItem(0)


With Sheets("BuyerEmails")
    Set rngTo = .Range("AA35")
  '  Set rngCc = .Range("AC39")
  '  Set rngBCC = .Range("AW8")
    Set rngSubject = .Range("N142")
    Set rngBody = .Range("N143:N143")
End With


'rngBody.Copy ' I put this back in


With objMail
     .To = rngTo.Value
'    .CC = rngCc.Value
'    .BCC = rngBCC.Value
    .Subject = rngSubject.Value
    .HTMLBody = RangetoHTML(rngBody) & StrSignature
    .Display
End With


Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngCc = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing


'Call sourceSheet.Activate


End Sub

Display More

RealtorScott · Jan 26th 2018

I guess I can move the MsgBox to the 40+ other Macros that generate different boiler plate emails. I was just trying to avoid all the extra code.

Mumps · Jan 26th 2018

Since the buyer general email calls the CopySaleInfoToBuyerEmailsSheet macro, when you answer "No" to the prompt, you exit the CopySaleInfoToBuyerEmailsSheet macro and return to the next line of code in the BuyerEmailsGeneral macro and it continues to run from there. If you eliminate the CopySaleInfoToBuyerEmailsSheet macro and combine it with the BuyerEmailsGeneral macro, then when you answer "No" the BuyerEmailsGeneral macro will be exited and the rest of the code will not continue to run. I hope this makes sense. It would look like this:

Code

Sub BuyerEmailsGeneral()
    ' This email is sent to:
    'Dim sourceSheet As Worksheet
    'Set sourceSheet = ActiveSheet
    If MsgBox("Warning!!!  You have to run this macro from an active 'Sale Sheet'." & vbCrLf & "Would you like to Continue?" & vbCrLf & "Select 'Yes' or 'No' to continue", vbYesNo + vbCritical, "Selection") = vbNo Then Exit Sub
    '    Range("AJ32:BT160").Copy Sheets("BuyerEmails").Range("H10")
      '  Range("AJ32:BT160").Copy Destination:=Sheets("BuyerEmails").Range("H10")
    Range("AJ32:BT160").Copy
    Sheets("BuyerEmails").Range("H10:BT138").PasteSpecial Paste:=xlPasteValues, Transpose:=False
   
    Dim objOutlook As Object
    Dim objMail As Object
    Dim rngTo As Range
    Dim rngCc As Range
    Dim rngBCC As Range
    Dim rngSubject As Range
    Dim rngBody As Range
    Dim StrSignature As String
    'StrSignature = GetSignature(Environ("Userprofile") & "\AppData\Roaming\Microsoft\Signatures\Default.htm")
   
    Set objOutlook = CreateObject("Outlook.Application")
    Set objMail = objOutlook.CreateItem(0)
   
    With Sheets("BuyerEmails")
        Set rngTo = .Range("AA35")
      '  Set rngCc = .Range("AC39")
      '  Set rngBCC = .Range("AW8")
        Set rngSubject = .Range("N142")
        Set rngBody = .Range("N143:N143")
    End With
   
    'rngBody.Copy ' I put this back in
   
    With objMail
         .To = rngTo.Value
    '    .CC = rngCc.Value
    '    .BCC = rngBCC.Value
        .Subject = rngSubject.Value
        .HTMLBody = RangetoHTML(rngBody) & StrSignature
        .Display
    End With
   
    Set objOutlook = Nothing
    Set objMail = Nothing
    Set rngTo = Nothing
    Set rngCc = Nothing
    Set rngSubject = Nothing
    Set rngBody = Nothing
   
    'Call sourceSheet.Activate
End Sub

Display More

You would have to do the same with the other BuyerEmails (1 to 10) macros.

RealtorScott · Jan 26th 2018

Thanks Mumps, you have been a great help and I truly appreciate your time.

Scott

Mumps · Jan 26th 2018

You are very welcome.

Workbook_SheetChange, continues to loop with a Case Statement

Participate now!

Share