Results 1 to 3 of 3

Only one of two codes in worksheet works

This is a discussion on Only one of two codes in worksheet works within the Excel Questions forums, part of the Question Forums category; The code below does two different things when a user clicks on a cell. The green code creates a box ...

  1. #1
    Board Regular
    Join Date
    May 2009
    Location
    Atlanta, GA
    Posts
    383

    Default Only one of two codes in worksheet works

    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.

    Code:
    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

  2. #2
    MrExcel MVP Damon Ostrander's Avatar
    Join Date
    Feb 2002
    Location
    Denver, Colorado USA
    Posts
    4,163

    Default Re: Only one of two codes in worksheet works

    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
    Keep Excelling.

    Damon

    VBAexpert Excel Consulting
    LinkedIn Profile http://www.linkedin.com/pub/damon-ostrander/7/79/a93
    AllExperts Profile http://www.allexperts.com/ep/1059-30...-Ostrander.htm
    (My other life: http://damonostrander.com )

  3. #3
    Board Regular
    Join Date
    May 2009
    Location
    Atlanta, GA
    Posts
    383

    Default Re: Only one of two codes in worksheet works

    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

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

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


DMCA.com