Results 1 to 10 of 10

Sub Worksheet_SelectionChange question

This is a discussion on Sub Worksheet_SelectionChange question within the Excel Questions forums, part of the Question Forums category; I have the code below in my worksheet. The code in blue creates a pop-up box when a cell with ...

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

    Default Sub Worksheet_SelectionChange question

    I have the code below in my worksheet. The code in blue creates a pop-up box when a cell with a value in column Q, S, or U is selected. The code in red calls a macro when any cell containing the word "Exit" is selected. "Exit" never appears in column Q, S, or U.

    Each of these codes works fine independently. However, when the popup code appears first (as shown below), the "Exit" code does not work - nothing happens. If I reverse the order of these two codes, the red before the blue, the "Exit" code works fine AND the popup code works for column U. It does not work for column Q or S.

    Any idea how I can tweak this to combine it effectively? Thanks!

    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
    Board Regular
    Join Date
    Aug 2012
    Location
    Launceston, UK
    Posts
    845

    Default Re: Sub Worksheet_SelectionChange question

    Hi Christine,

    I can't be certain but it looks as if you have a number of Exit Sub statements in the Blue code that will eject your from the routine before the Red code is reached.

    My suggestion would be to use the Debugger in VBE (select a line near the top of the procedure and press F9, this will create a breakpoint that will let you step through the code with F8 (or use Debug menu) and examine the variables to see what is happening). That should also show you where the flow of the code differs from what you expect.

    Not a lot of help I'm afraid, but at least a strategy to help you find the answer.

    All the best.
    Peter

    Excel 2010, Windows 7
    Accuracy in posting formula's to the forum will help enormously!!

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

    Default Re: Sub Worksheet_SelectionChange question

    This Debugger is good to know about. I am able to create a breakpoint with F9, but the F8 does not advance through the code; it just hangs up and I get an error ding sound.

  4. #4
    Board Regular
    Join Date
    Aug 2012
    Location
    Launceston, UK
    Posts
    845

    Default Re: Sub Worksheet_SelectionChange question

    Hi Christine,

    I think that that is because you can't start the worksheet_selectionchange macro directly with the F8 key (you can for code in a normal module). You need to trigger an event to make it run. Thus you need to set the break point, then go to the spreadsheet and change the cell selection which will then trigger the macro which will stop running at the point you've set the breakpoint.

    A coupe of things:

    1. You won't be able to set the break point on a comment.
    2. You can inspect the value of variables either by hovering the mouse over them and there value is (usually) displayed, if that doesn't work you can inspect them either by setting a watch on them or by going to the immediate window (usually at the bottom, but you may need to enable it in the view menu) and then typing something like: print target.address which will then show you the address passed to the macro.
    3. If you have code which will take a long time to reach using F8, for example to get through a loop that you know is correct, then click on the next code statement of interest and from the Debug menu choose Run to Cursor or hit Ctrl-F8.


    Hope this helps.

    Regards
    Peter

    Excel 2010, Windows 7
    Accuracy in posting formula's to the forum will help enormously!!

  5. #5
    Board Regular
    Join Date
    May 2009
    Location
    Atlanta, GA
    Posts
    426

    Default Re: Sub Worksheet_SelectionChange question

    Yes, this works for the debugger! I will now work through the code to detect the problem. Thank you for these clear, detailed instructions. This is extremely useful! CJ

  6. #6
    Board Regular
    Join Date
    Aug 2012
    Location
    Launceston, UK
    Posts
    845

    Default Re: Sub Worksheet_SelectionChange question

    many thanks for the feedback, do let me know how you get on.
    Peter

    Excel 2010, Windows 7
    Accuracy in posting formula's to the forum will help enormously!!

  7. #7
    Board Regular
    Join Date
    Aug 2012
    Location
    Launceston, UK
    Posts
    845

    Default Re: Sub Worksheet_SelectionChange question

    Hi Christine,

    Couldn't resist the temptation to try and resolve the issue properly. The problem lies in the flow of the code, which comes to too many exits. I've now grouped all the initial conditions and so that if they're not met then the flow passes to the code that was in red. I've taken the liberty to change a few constructs (around things like the definition of rng2 which seemed strange. As far as I can tell it now works, but you'll need to check it carefully - use the debugger to see what is happening.

    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
        '*
        '* Exit if not in range
        
        With Target
            ' test whether there is more than one cell in the selection, that the cell is in
            ' column 'Q', 'S', or 'U' (Each of these is a named range), that there is something in the cell
            ' and that it has a validation rule applied.
            lDVType = 99
            lDVType = Target.Validation.Type
            If 1 < .Cells.Count Or _
                    Application.Intersect(.Cells, Union(Range("ColumnQ"), Range("ColumnS"), Range("ColumnU"))) Is Nothing Or _
                    .Value = "" Or lDVType = 99 Then
            
                sTemp.TextFrame.Characters.Text = ""
                sTemp.Visible = msoFalse
    '        Exit Sub
            Else
                Application.EnableEvents = False
                .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
            
                On Error GoTo 0
                Application.EnableEvents = True
            End If
        End With
    
        If Target.Count > 1 Or Intersect(Target, Range("T1:KH1100")) 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
    Hope this helps.

    Regards
    Peter

    Excel 2010, Windows 7
    Accuracy in posting formula's to the forum will help enormously!!

  8. #8
    Board Regular
    Join Date
    May 2009
    Location
    Atlanta, GA
    Posts
    426

    Default Re: Sub Worksheet_SelectionChange question

    Peter -

    Your revision works absolutely perfectly. Now that I see what you have done, it makes sense to me. I have only a very basic knowledge of this type of coding and could not have gotten this on my own.

    Thank you so much for following up with this! I learned a lot. Christine

  9. #9
    Board Regular
    Join Date
    Aug 2012
    Location
    Launceston, UK
    Posts
    845

    Default Re: Sub Worksheet_SelectionChange question

    my Pleasure Christine, I enjoy the challenge and if you've learnt something too then we both win!!

    PS. I've just noticed that I left in a commented out 'Exit Sub' which you could delete without causing problems.
    Peter

    Excel 2010, Windows 7
    Accuracy in posting formula's to the forum will help enormously!!

  10. #10
    Board Regular
    Join Date
    May 2009
    Location
    Atlanta, GA
    Posts
    426

    Default Re: Sub Worksheet_SelectionChange question

    I'll remove the comment - I see it. Thanks once again!

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