Sub Worksheet_SelectionChange question

ChristineJ

Well-known Member
Joined
May 18, 2009
Messages
756
Office Version
  1. 365
Platform
  1. Windows
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!

Rich (BB 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
 

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
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.
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
many thanks for the feedback, do let me know how you get on.
 
Upvote 0
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,497
Messages
6,113,998
Members
448,539
Latest member
alex78

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top