Only one of two codes in worksheet works

[ChristineJ]

The code below does two different things when a user clicks on a cell. The green code creates a box that contains text from one of three named ranges. The orange code calls a macro when a cell is clicked on that contains the word EXIT.

Both codes work fine separately, but when I put them both under the Worksheet_Selection Change, only the first one works. In the case below, the EXIT code does not work. If I put that code first, it will work but the other won't. I'd appreciate help with what I have wrong here.

Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range) 

Dim strTitle As String
    Dim strMsg As String
    Dim lDVType As Long
    Dim sTemp As Shape
    On Error Resume Next
    Set sTemp = ActiveSheet.Shapes("txtInputMsg")
    '*
    '* Add the box if does not exist
    If Err.Number <> 0 Then
        Set sTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 72, 72)
        sTemp.Name = "txtInputMsg"
    End If
    On Error GoTo 0
    '*
    '* Exit if not in range
With Target
    'Each of these is a named range
    If 1 < .Cells.Count Or _
        Application.Intersect(.Cells, Union(Range("ColumnQ"), Range("ColumnS"), Range("ColumnU"))) Is Nothing Then
        sTemp.Visible = False
        Exit Sub
    End If
    '*
    '* One cell selected, exit if empty
    If .Value = "" Then
        sTemp.Visible = False
        Exit Sub
    End If
End With
    '*
    '* Exit if Cell doesn't have validation rule
    On Error Resume Next
    lDVType = 99
    lDVType = Target.Validation.Type
    If lDVType = 99 Then
        sTemp.TextFrame.Characters.Text = ""
        sTemp.Visible = msoFalse
        On Error GoTo 0
        Exit Sub
    End If
    '*
    '* Display the box
    Application.EnableEvents = False
    With Target
        .Validation.ShowInput = False
        Select Case .Column
            'Each of these is the column number
            Case 17    '* Column Q
                strTitle = IIf(CStr(Range("AO" & .Row)) = "", "", (CStr(Range("AO" & .Row)) & vbCr)) & _
                    IIf(CStr(Range("AP" & .Row)) = "", "", (CStr(Range("AP" & .Row)) & vbCr)) & _
                    IIf(CStr(Range("AQ" & .Row)) = "", "", (CStr(Range("AQ" & .Row)) & vbCr))
                strMsg = IIf(CStr(Range("AG" & .Row)) = "", "ANSWER:   Leave blank", "ANSWER:   " & _
                    CStr(Range("AG" & .Row)))
    
            Case 19    '* Column S
                strTitle = IIf(CStr(Range("AR" & .Row)) = "", "", (CStr(Range("AR" & .Row)) & vbCr)) & _
                    IIf(CStr(Range("AS" & .Row)) = "", "", (CStr(Range("AS" & .Row)) & vbCr)) & _
                    IIf(CStr(Range("AT" & .Row)) = "", "", (CStr(Range("AT" & .Row)) & vbCr))
                strMsg = IIf(CStr(Range("AI" & .Row)) = "", "ANSWER:   Leave blank", "ANSWER:   " & _
                    CStr(Format(Range("AI" & .Row), "#,###")))
    
            Case 21    '* Column U
                strTitle = IIf(CStr(Range("AU" & .Row)) = "", "", (CStr(Range("AU" & .Row)) & vbCr)) & _
                    IIf(CStr(Range("AV" & .Row)) = "", "", (CStr(Range("AV" & .Row)) & vbCr)) & _
                    IIf(CStr(Range("AW" & .Row)) = "", "", (CStr(Range("AW" & .Row)) & vbCr))
                strMsg = IIf(CStr(Range("AK" & .Row)) = "", "ANSWER:   Leave blank", "ANSWER:   " & _
                    CStr(Format(Range("AK" & .Row), "#,###")))
    
        End Select
        strMsg = IIf(Range("B1") = 3, "", strMsg)
        strTitle = IIf(Range("B1") = 2, "", strTitle)
        '*
        '* Remove last vbCR from strTitle if strMsg = ""
        strTitle = IIf(strMsg = "", LEFT(strTitle, Len(strTitle) - 1), strTitle)
        sTemp.TextFrame.Characters.Text = strTitle & strMsg
        sTemp.TextFrame.AutoSize = True
        sTemp.TextFrame.Characters.Font.Bold = False
        sTemp.TextFrame.Characters(1, Len(strTitle)).Font.Bold = False
        sTemp.LEFT = .Offset(0, -5).LEFT
        sTemp.Top = .Top - sTemp.Height
        sTemp.Visible = msoTrue
    End With
    On Error GoTo 0
    Application.EnableEvents = True

    Dim rng2 As Range
        Set rng2 = Target.Parent.Range("T1:KH1100")
            If Target.Count > 1 Then Exit Sub
            If Intersect(Target, rng2) Is Nothing Then Exit Sub
            If Target.Value = "Exit" And Range("C2").Value = "Split" Then
                Call FullScreenShowAll_2
            ElseIf Target.Value = "Exit" And Range("C2").Value = "Full" Then
                Call ShowAll
                Range("C2").Value = "Split"
            End If

End Sub

 

[Damon Ostrander]

Hi ChristineJ,

I believe the problem is that "Application.EnableEvents = True" should be moved to the end of the Sub after the orange code so that the code doesn't call itself recursively when it sets the value of the Target cell to either "Full" or "Split". When this happens I believe the green block of code will exit on one of the Exit Sub conditions. Please give it a try and let me know.

Damon

 

[ChristineJ]

Thanks for the feedback. It did not seem to work by moving "Application.EnableEvents = True". However, I did finally get it to work by changing the start point of the range in the orange code from T1 to A1.

I really appreciate your help! CJ