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