ChristineJ
Well-known Member
- Joined
- May 18, 2009
- Messages
- 761
- Office Version
- 365
- Platform
- 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!
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