Consulting

Results 1 to 9 of 9

Thread: Is there code similar to "If Not Application.Intersect" & "If Not Intersect(Target..

  1. #1
    VBAX Regular
    Joined
    Jul 2018
    Posts
    12
    Location

    Is there code similar to "If Not Application.Intersect" & "If Not Intersect(Target..

    I already have code using If Not Intersect(Target...., so I can't use that again. I have 2 groups of code for the same cell range, using "If not Application.Intersect", when 1 runs the other runs also. I think I may have to use different code to have only 1 group of code run.

    Here is the 1st group of code:
    Option Explicit
    ' This works on the row, M when pending is entered, it also opens the users Outlook calendar.
    ' Pending #1. Example #1
       Set KeyCells = Range("M3:M329")
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
     Application.Speech.Speak "Schedule two. appointments on your calendar. The first appointment. is a reminder. to send a contact letter. (if no response from the Phone call). Use the Red date to the right. The second appointment. is a reminder.  two weeks later. to cancel the consult. if NO response from earlier attempts.", SpeakAsync:=True
           Application.Wait (Now + TimeValue("00:00:2"))
       VBA.MsgBox "Schedule two appointments on your calendar. The first appointment is a reminder to send a contact letter (if no response from Phone call.)  Use the Red date to the right. The second appointment is a reminder two weeks later to cancel the consult, if NO response from earlier attempts.", vbOKOnly + vbInformation, _
                           "Vocational Services Reminder"
                           
         'Opens Outlook appointment Calendar.
    Dim olApp As Object ' Outlook.Application
    Set olApp = CreateObject("Outlook.Application")
    olApp.Session.GetDefaultFolder(olFolderCalendar).Display
    End If
    Group 1 does run as expected, but then goes to group 2.
    Here I the code for group 2:

    ' This works on the row, M when pending is deleted, it also opens the users Outlook calendar.
    ' Pending #2. 
    
    Set KeyCells = Range("M3:M329")
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
     Dim Ans As Integer
          Ans = MsgBox("Two appointments were scheduled on your calendar previously. One for a Contact Letter, one to Cancel the Consult " & vbCrLf & vbNewLine & "Click Yes to delete the future appointments,if veteran contacted you.  Click No, if there was no contact from the veteran.", vbYesNo, "Vocational Services Database - " & ActiveSheet.Name)
          Select Case Ans
              Case vbYes
           '[code if Ans is Yes]...
           'Opens Outlook appointment Calendar.
    Dim olApp2 As Object ' Outlook.Application
    Set olApp2 = CreateObject("Outlook.Application")
    olApp.Session.GetDefaultFolder(olFolderCalendar).Display
    Range("$M$3:$M$329").ClearContents
       Case vbNo
      '       ...[code if Ans is No]...
      MsgBox " Enter the reason in the Column. You can choose from the drop down list or enter a new one.", vbInformation, "Vocational Services Database - " & ActiveSheet.Name
      ActiveCell.Offset(0, -1).Select
          End Select
          Exit Sub
    End If
    
    End Sub
    End Sub
    This group of code runs, but does not clear contents, & then goes to code group 1. Am I correct in thinking that I have to find different code for group 2?

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master xld's Avatar
    Joined
    Apr 2005
    Posts
    25,079
    Location
    That first code is not in a sub so cannot possibly run, the second has no sub definition, but 2 end subs, so will not run either.

    What exactly are you trying to do?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    VBAX Regular
    Joined
    Jul 2018
    Posts
    12
    Location
    I am trying to have 2 actions take place. Action 1. A user enters "Pending in Column range 3:329. a reminder window opens, the user clicks OK, & the Outlook Calendar opens. At a later date Pending is deleted, the user has 2 choices. Yes deletes pending, & Outlook calendar opens. No deletes pending, & the active cell is 1 cell to the left. I have included the entire batch of code, since my posting previously was not accurate enough. The areas I am having trouble with is pending 1 & 2.

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    ' This code strips the first 5 of the Social Security.
    'You can have only 1 "If Not Intersect" statement. If more, they do not run below this section.
    Dim SSNcell As Range
        'Test whether content should be an abbreviated SSN
       'This restricts the area of application of the event handler
       If Not Intersect(Target, Range("SSN")) Is Nothing Then
            'Make sure the program does not trigger a further event
           Application.EnableEvents = False
            'Loop over intersection
           For Each SSNcell In Intersect(Target, Range("SSN"))
                SSNcell.Value = VBA.Right(SSNcell.Value, 4)
            Next
            'Reset
           Application.EnableEvents = True
        End If
        
        
    ' This works in the row that contains names.
          Dim KeyCells As Range
    ' The variable KeyCells contains the cells that will
        ' cause an alert when they are changed.
        Set KeyCells = Range("C3:C329")
    
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    
     Application.Speech.Speak "Copy the  Social Security Number directly from C P R S.    The system stips the first five numbers.  ", SpeakAsync:=True
           Application.Wait (Now + TimeValue("00:00:2"))
         MsgBox " Copy the Social Security Number directly from CPRS. The system strips the first five numbers.  ", vbInformation, "Vocational Services Database - " & ActiveSheet.Name
        Else
    
    
    End If
     
      
    ' This works on the row, M when pending is entered, it also opens the users Outlook calendar.
    ' Pending #1. 
    
    
       Set KeyCells = Range("M3:M329")
    
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
    
    
     Application.Speech.Speak "Schedule two. appointments on your calendar. The first appointment. is a reminder. to send a contact letter. (if no response from the Phone call). Use the Red date to the right. The second appointment. is a reminder.  two weeks later. to cancel the consult. if NO response from earlier attempts.", SpeakAsync:=True
           Application.Wait (Now + TimeValue("00:00:2"))
       VBA.MsgBox "Schedule two appointments on your calendar. The first appointment is a reminder to send a contact letter (if no response from Phone call.)  Use the Red date to the right. The second appointment is a reminder two weeks later to cancel the consult, if NO response from earlier attempts.", vbOKOnly + vbInformation, _
                           "Vocational Services Reminder"
                           
         'Opens Outlook appointment Calendar.
    Dim olApp As Object ' Outlook.Application
    Set olApp = CreateObject("Outlook.Application")
    olApp.Session.GetDefaultFolder(olFolderCalendar).Display
    End If
    
    
    
    
    ' The user is notified to take appropiate action, when VR is entered in column N.
        Set KeyCells = Range("N3:N329")
    
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
               
       Application.Speech.Speak "Click. Vocational Asstistance. Update Button. and verify that the name was entered. If it was entered. Click yes. for the appropriate service.", SpeakAsync:=True
       VBA.MsgBox "Click Voc Asst Update Button, & verify that name was entered. If entered, Click yes for the appropriate service.", vbOKOnly + vbInformation, _
                           "Vocational Services Reminder"
    
    
    End If
    
    
    
    
    ' This works on the row, M when pending is deleted, it also opens the users Outlook calendar.
    ' Pending #2. 
    
    
    Set KeyCells = Range("M3:M329")
    
    
    
    
    If Not Application.Intersect(KeyCells, Range(Target.Address)) _
               Is Nothing Then
     Dim Ans As Integer
          Ans = MsgBox("Two appointments were scheduled on your calendar previously. One for a Contact Letter, one to Cancel the Consult " & vbCrLf & vbNewLine & "Click Yes to delete the future appointments,if veteran contacted you.  Click No, if there was no contact from the veteran.", vbYesNo, "Vocational Services Database - " & ActiveSheet.Name)
          Select Case Ans
              Case vbYes
           '[code if Ans is Yes]...
           'Opens Outlook appointment Calendar.
    Dim olApp2 As Object ' Outlook.Application
    Set olApp2 = CreateObject("Outlook.Application")
    olApp.Session.GetDefaultFolder(olFolderCalendar).Display
    Range("$M$3:$M$329").ClearContents
       Case vbNo
      '       ...[code if Ans is No]...
     MsgBox " Enter the reason in the Column. You can choose from the drop down list or enter a new one.", vbInformation, "Vocational Services Database - " & ActiveSheet.Name
      ActiveCell.Offset(0, -1).Select
          End Select
          Exit Sub
    End If
    End Sub
    Currently, when Pending 1 runs pending 2 also runs.

    Here is the problems with pending 2; if the user clicks "Yes" it goes back to Pending #1; if no is clicked, Pending is not deleted, & the 1st cell left of M, becomes the active cell. If I comment out pending 2, Pending 1 works as expected.

  4. #4
    VBAX Regular
    Joined
    Jul 2018
    Posts
    12
    Location
    ok. I commented out pending #2, & am trying a different approach. BY commenting out Pending #2, Pending #1 works like a charm. I am thinking that Delete key activation code may solve my problem, for #2. I am looking for the groups thoughts. Also could it be limited to 1 column?

  5. #5
    VBAX Regular
    Joined
    Jul 2018
    Posts
    12
    Location
    I replaced pending #2 with the following code & placed it at the beginning of Worksheet_Change.
    Private Sub Worksheet_Change(ByVal Target As Range)If Trim(Target.Value) = Empty Then
    Dim Ans As Integer
         Ans = MsgBox("Two appointments were scheduled on your calendar previously. One for a Contact Letter, one to Cancel the Consult " & vbCrLf & vbNewLine & "Click Yes to delete the future appointments,if veteran contacted you.  Click No, if there was no contact from the veteran.", vbYesNo, "Vocational Services Database - " & ActiveSheet.Name)
          Select Case Ans
              Case vbYes
           '[code if Ans is Yes]...
           'Opens Outlook appointment Calendar.
    Dim olApp2 As Object ' Outlook.Application
    Set olApp2 = CreateObject("Outlook.Application")
    olApp2.Session.GetDefaultFolder(olFolderCalendar).Display
    Range("$M$3:$M$329").ClearContents
       Case vbNo
      '       ...[code if Ans is No]...
     MsgBox " Enter the reason in the Column. You can choose from the drop down list or enter a new one.", vbInformation, "Vocational Services Database - " & ActiveSheet.Name
      ActiveCell.Offset(0, -1).Select
          End Select
          Exit Sub
    End If
    It runs & then throws a run time error '13' Type Mismatch on "If Trim(Target.Value) = Empty Then". Please educate me on what I am doing wrong & how to correct it. The other portions of the code work as expected.

  6. #6
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,597
    Location
    Try

    If Len(Trim(Target.Value)) = 0 Then
    
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  7. #7
    VBAX Regular
    Joined
    Jul 2018
    Posts
    12
    Location
    I tried your code. It ran, but did not let ....when pending is entered..... run. I have attached a sample, & hope I did it correctly. I narrowed down the problem. If "Pending" is deleted & :Yes" is selected, it runs & gives an error code. If "No" is chosen, it runs & no error code.
    Attached Files Attached Files
    Last edited by FrankM; 07-23-2019 at 07:08 AM. Reason: Additional information

  8. #8
    VBAX Wizard
    Joined
    Apr 2007
    Posts
    6,597
    Location
    You didn't say how to reproduce the issue, but just making a Delete on the Referals sheet I got the error

    Some where in your code you're getting a Target with multiple cells and Trim doesn't work


    Capture.JPG
    Paul

    ------------------------------------------------------------------------------------------------------------------------
    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s)
    (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  9. #9
    VBAX Regular
    Joined
    Jul 2018
    Posts
    12
    Location
    Paul. I appreciate your help. The problem is solved. Here is what I did. I added Application.EnableEvents = False & Application.EnableEvents = True.
    Here is the code:

    Private Sub Worksheet_Change(ByVal Target As Range)
    
     'This code is activated if the delete key is activated,
    If Trim(Target.Value) = Empty Then
    Dim Ans As Integer
    Application.Speech.Speak "Two appointments were scheduled on your calendar previously. One for a Contact Letter, one to Cancel the Consult ", SpeakAsync:=True
           Application.Wait (Now + TimeValue("00:00:2"))
         Ans = MsgBox("Two appointments were scheduled on your calendar previously. One for a Contact Letter, one to Cancel the Consult " & vbCrLf & vbNewLine & "Click Yes to delete the future appointments,if veteran contacted you.  Click No, if there was no contact from the veteran.", vbYesNo + vbInformation, _
                           "Vocational Services Reminder")
          Select Case Ans
              Case vbYes
           '[code if Ans is Yes]...
           'Opens Outlook appointment Calendar.
    Dim olApp2 As Object ' Outlook.Application
    Set olApp2 = CreateObject("Outlook.Application")
    olApp2.Session.GetDefaultFolder(olFolderCalendar).Display
    Application.EnableEvents = False
    Range("$M$3:$M$329").ClearContents
    Application.EnableEvents = True
      End Select
      Select Case Ans
       Case vbNo
      '       ...[code if Ans is No]...
     MsgBox " Enter the reason in the Column. You can choose from the drop down list or enter a new one.", vbInformation, "Vocational Services Database - " & ActiveSheet.Name
      ActiveCell.Offset(0, -1).Select
          End Select
          Exit Sub
    End If
    I placed Application.EnableEvents = False, before Range("$M$3:$M$329").ClearContents, & Application.EnableEvents = True, after. I think it was caught in a loop without the False statement. The cell started out filled, then deleted. If "Yes" was selected it went back to code line #1 If Trim(Target.Value) = Empty Then. By adding both the False & TRUE statements, I was able to prevent the loop & turn the Excel Events back on for future use.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •