Preventing Call codes from running multiple times.

[FrancisM]

I have code that fluff was kind enough to help me with. It works as written, but when I added a call code, it would provide the following message multiple times "Check to verify veteran data is entered in FY ## REFERALS." "It's critical that the veteran data is captured." It didoes not matter if Yes or No is checked. the the response is the same. It then runs the call command the same number of times. I have tried moving moving the location of the call code, but the response is the same. Here is the code.

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

    Select Case Sh.CodeName
    'These are the worksheets here that are not to be called with change
         Case "Sheet1", "Sheet11", "Sheet21", "Sheet31", "Sheet41", "Sheet42", "Sheet43", "Sheet44", "Sheet 45", "Sheet46", "Sheet47", "Sheet48", "Sheet49", "Sheet50", "Sheet51", "Sheet52", "Sheet53", "Sheet54", "Sheet55", "Sheet56", "Sheet57", "Sheet82"
         
             Exit Sub
     End Select
     
     
     If Not (Application.Intersect(Target, Sh.Range("B4:B10, B13:B17")) _
       Is Nothing) Then   'Note that Range is now identified with the calling Sheet object variable (Sh)
         With Target
             If Not .HasFormula Then
                 Application.EnableEvents = False
                 .Value = UCase(.Value)
                 Application.EnableEvents = True
             End If
         End With
     End If
     'The code below is a reminder to enter data in the Referral Workbook.
     Application.ScreenUpdating = False
     Dim lastRow As Long
     Dim cell As Range
     lastRow = Range("G" & Rows.Count).End(xlUp).Row




   For Each cell In Range("H4:H10, H13:H17")
      If LCase(cell.Value) = "no" Then
         If Target.Value = "No" And Target.Offset(, 15).Value = True Then
            MsgBox "Check to verify veteran data is entered in FY ## REFERALS." & vbCr & _
                "It's critical that the veteran data is captured." & vbCr & _
                 "You have entered No into cell" & Target.Address, vbInformation, "Career Link Meeting List"
                
         End If
      End If
   Next
 'Call Referals
Application.ScreenUpdating = True


 End Sub

The piece of code that causing a problem is Call Referals​.

 

[FrancisM]

Checked that this is the file that you are talking about. The only difference is that it has your suggestions.

https://1drv.ms/x/s!Ah63gfPqLn_XhW35Y23utcAJaq2i

 

[Fluff]

The code in all three files is NOT the same as the code you supplied in Post#1.
Therefore the changes I suggested will not work.
Please delete the change event you are using & replace it with the code from post#1 along with the changes I suggested.
Do NOT simply upload another copy of you workbook, but try what I have now suggested 3 times.

 

[FrancisM]

The patch you provided does work. Thank for providing that & dealing with a person that wasn't seeing what was wrong with the other postings.
Here is the code so others my benefit from it.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Select Case Sh.CodeName
    'These are the worksheets here that are not to be called with change
         Case "Sheet1", "Sheet11", "Sheet21", "Sheet31", "Sheet41", "Sheet42", "Sheet43", "Sheet44", "Sheet 45", "Sheet46", "Sheet47", "Sheet48", "Sheet49", "Sheet50", "Sheet51", "Sheet52", "Sheet53", "Sheet54", "Sheet55", "Sheet56", "Sheet57", "Sheet82"
         
             Exit Sub
     End Select
     
     If Not (Application.Intersect(Target, Sh.Range("B4:B10, B13:B17")) _
       Is Nothing) Then   'Note that Range is now identified with the calling Sheet object variable (Sh)
         With Target
             If Not .HasFormula Then
                 Application.EnableEvents = False
                 .Value = UCase(.Value)
                 Application.EnableEvents = True
             End If
         End With
     End If
     'The code below is a reminder to enter data in the Referral Workbook.
     Application.ScreenUpdating = False
     Dim lastRow As Long
     Dim cell As Range
     lastRow = Range("G" & Rows.Count).End(xlUp).Row
   Dim Chk As Boolean
   For Each cell In Range("H4:H10, H13:H17")
      If LCase(cell.Value) = "no" Then
         If Target.Value = "No" And Target.Offset(, 15).Value = True Then
            MsgBox "Check to verify veteran data is entered in FY ## REFERALS." & vbCr & _
                "It's critical that the veteran data is captured." & vbCr & _
                 "You have entered No into cell" & Target.Address, vbInformation, "Career Link Meeting List"
             Chk = True
             Exit For
                End If
      End If
   Next
 If Chk Then Call Referals
Application.ScreenUpdating = True
End Sub

 

[Fluff]

Glad you figured it out & thanks for the feedback