Expanding an IF...Then Statement

[ChristineJ]

I have been successfully using the following code in a workbook so that when a cell in B6:B16 is selected, the contents in three cells to the right in columns E, F, and L in the same row appears in a pop-up box. The cells in B6:B16 each contain an input message under Data Validation, but the "Show input message when cell is selected" is not checked. It works perfectly.

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim strTitle As String
    Dim strMsg As String
    Dim lDVType As Long
    Dim sTemp As Shape
    Application.EnableEvents = False
    On Error Resume Next
    Set sTemp = ActiveSheet.Shapes("txtInputMsg")
    '* If the box does not exist, add it
    If Err.Number <> 0 Then
        Set sTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 72, 72)
        sTemp.Name = "txtInputMsg"
    End If
    On Error GoTo 0
    sTemp.TextFrame.Characters.Text = ""
    sTemp.Visible = False
    With Target
        If 1 = .Cells.Count And Not Application.Intersect(.Cells, Range("B6:B16")) Is Nothing Then
            lDVType = 99
            On Error Resume Next
            lDVType = .Validation.Type
            On Error GoTo 0
            If lDVType <> 99 And .Value <> "" Then
                Rem put text in box
                strTitle = CStr(Range("E" & Target.Row)) & vbCr
                strMsg = CStr(Range("F" & Target.Row)) & IIf(CStr(Range("L" & Target.Row)) = "", vbNullString, vbCr) & CStr(Range("L" & Target.Row))
                sTemp.TextFrame.Characters.Text = strTitle & strMsg
                Rem size and format text box
                sTemp.TextFrame.AutoSize = True
                sTemp.TextFrame.Characters.Font.Bold = False
                sTemp.TextFrame.Characters(1, Len(strTitle)).Font.Bold = False
                Rem position text box
                sTemp.Left = .Offset(0, 1).Left
                'I changed the 0 to 1
                sTemp.Top = .Top - sTemp.Height
                Rem show text box
                sTemp.Visible = msoTrue
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub

I want to duplicate that and ALSO use the content in columns H, K, and J when a cell in D6:D16 is selected.

I have been trying to insert this code that was suggested below into what I had, but I am clearly not doing it correctly because I get a compile error: Else without If. Any suggestions?

With Target
    If 1 = .Cells.Count And Not Application.Intersect(.Cells, Range("B6:B16")) Is Nothing Then
        '*
        '* Code for B6:B16
    ElseIf 1 = .Cells.Count And Not Application.Intersect(.Cells, Range("D6:D16")) Is Nothing Then
        '*
        '* Code for D6:D16
    End If
End With

Here is my attempt at combining the two codes above:

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim strTitle As String
    Dim strMsg As String
    Dim lDVType As Long
    Dim sTemp As Shape
    Application.EnableEvents = False
    On Error Resume Next
    Set sTemp = ActiveSheet.Shapes("txtInputMsg")
    '* If the box does not exist, add it
    If Err.Number <> 0 Then
        Set sTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 72, 72)
        sTemp.Name = "txtInputMsg"
    End If
    On Error GoTo 0
    sTemp.TextFrame.Characters.Text = ""
    sTemp.Visible = False
    With Target
        If 1 = .Cells.Count And Not Application.Intersect(.Cells, Range("B6:B16")) Is Nothing Then
            lDVType = 99
            On Error Resume Next
            lDVType = .Validation.Type
            On Error GoTo 0
            If lDVType <> 99 And .Value <> "" Then
                Rem put text in box
                strTitle = CStr(Range("E" & Target.Row)) & vbCr
                strMsg = CStr(Range("F" & Target.Row)) & IIf(CStr(Range("L" & Target.Row)) = "", vbNullString, vbCr) & CStr(Range("L" & Target.Row))
                sTemp.TextFrame.Characters.Text = strTitle & strMsg
                Rem size and format text box
                sTemp.TextFrame.AutoSize = True
                sTemp.TextFrame.Characters.Font.Bold = False
                sTemp.TextFrame.Characters(1, Len(strTitle)).Font.Bold = False
                Rem position text box
                sTemp.Left = .Offset(0, 1).Left
                'I changed the 0 to 1
                sTemp.Top = .Top - sTemp.Height
                Rem show text box
                sTemp.Visible = msoTrue
            End If
        End If
        
         ElseIf 1 = .Cells.Count And Not Application.Intersect(.Cells, Range("D6:D16")) Is Nothing Then
            lDVType = 99
            On Error Resume Next
            lDVType = .Validation.Type
            On Error GoTo 0
            If lDVType <> 99 And .Value <> "" Then
                Rem put text in box
                strTitle = CStr(Range("E" & Target.Row)) & vbCr
                strMsg = CStr(Range("F" & Target.Row)) & IIf(CStr(Range("L" & Target.Row)) = "", vbNullString, vbCr) & CStr(Range("L" & Target.Row))
                sTemp.TextFrame.Characters.Text = strTitle & strMsg
                Rem size and format text box
                sTemp.TextFrame.AutoSize = True
                sTemp.TextFrame.Characters.Font.Bold = False
                sTemp.TextFrame.Characters(1, Len(strTitle)).Font.Bold = False
                Rem position text box
                sTemp.Left = .Offset(0, 1).Left
                'I changed the 0 to 1
                sTemp.Top = .Top - sTemp.Height
                Rem show text box
                sTemp.Visible = msoTrue
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub

 

[RoryA]

Syntactically, you just need to remove the End If before your ElseIf line. I haven't yet checked the code itself (which seems to be the same in both parts?)

 

[RoryA]

Untested, but perhaps

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lDVType              As Long
Dim sTemp                As Shape
    Application.EnableEvents = False
    On Error Resume Next
    Set sTemp = ActiveSheet.Shapes("txtInputMsg")
    '* If the box does not exist, add it
    If Err.Number <> 0 Then
        Set sTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 10, 10, 72, 72)
        sTemp.Name = "txtInputMsg"
    End If
    On Error GoTo 0
    sTemp.TextFrame.Characters.Text = ""
    sTemp.Visible = False
    With Target
        If 1 = .Cells.Count And Not Application.Intersect(.Cells, Range("B6:B16,D6:D16")) Is Nothing Then
            lDVType = 99
            On Error Resume Next
            lDVType = .Validation.Type
            On Error GoTo 0
            If lDVType <> 99 And .Value <> "" Then
                ShowShape sTemp, Target, IIf(Target.Column = 2, "E,F,L", "H,K,J")
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub


Sub ShowShape(shp As Shape, rngParent As Range, strCols As String)
Dim strTitle             As String
Dim strMsg               As String
Dim vCols
Dim lngRow               As Long
Dim n                    As Long

    'strCols is a comma separated list of column Letters to use for message
    vCols = Split(strCols, ",")

    With rngParent
        lngRow = .Row
        With .Worksheet
            strTitle = CStr(.Range(vCols(0) & lngRow))
            If UBound(vCols) > 0 Then
                For n = 1 To UBound(vCols)
                    strMsg = strMsg & IIf(Len(Trim(.Range(vCols(n) & lngRow))) = 0, vbNullString, _
                                          vbCr & Trim(.Range(vCols(n) & lngRow)))
                Next n
            End If
        End With
    End With
    With shp
        With .TextFrame
            ' size and format text box
            .AutoSize = True
            With .Characters
                .Text = strTitle & strMsg
                .Font.Bold = False
            End With
            .Characters(1, Len(strTitle)).Font.Bold = False
        End With
        ' position text box
        .Left = rngParent.Offset(0, 1).Left
        'I changed the 0 to 1
        .Top = rngParent.Top - .Height
        ' show text box
        .Visible = msoTrue
    End With

End Sub

 

[ChristineJ]

Thank you. I removed the EndIf and got it to work. Appreciate the assistance!