Data Validation Input Message workaround 255 char

Question

I am trying to create a workaround for the Data Validation Input Message, since my input message is more than 255 chars.
I have tried http://contextures.com/xlDataVal12.html but the text box is fixed. I would need the text box or label to move with the selected cell.

On the image below, you can see the issue. We cannot display the whole message within the input box.

1 http://img5013.photobox.co.uk/42779160c8143d2fcab8c396d411e8b621181c1be9f1a01fb62e272d26debaf4b53f7657.jpg

Dick Kusleika Dick Kusleika · Accepted Answer · 2015-07-21T14:03:53

Using the Contextures code, you need to set the .Top and .Left properties of the shape to the same properties of a cell. Here's a rewrite of that code that moves the textbox near the cell.

' Developed by Contextures Inc.
' www.contextures.com
' modified by Dick Kusleika 7/21/2015
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim sTitle As String
    Dim sMsg As String
    Dim sMsgAdd As String
    Dim tbxTemp As Shape
    Dim lDVType As Long
    Dim lRowMsg As Long
    Dim ws As Worksheet

    Application.EnableEvents = False

    Set ws = Target.Parent
    Set tbxTemp = ws.Shapes("txtInputMsg")

    On Error Resume Next
        lDVType = 0
        lDVType = Target.Validation.Type
    On Error GoTo errHandler

    If lDVType = 0 Then
        tbxTemp.TextFrame.Characters.Text = vbNullString
        tbxTemp.Visible = msoFalse
    Else
        If Len(Target.Validation.InputTitle) > 0 Or Len(Target.Validation.InputMessage) > 0 Then

            sTitle = Target.Validation.InputTitle & vbLf

            On Error Resume Next
                lRowMsg = 0
                lRowMsg = Application.WorksheetFunction.Match(Target.Validation.InputTitle, Sheets("MsgText").Columns(1), 0)
                If lRowMsg > 0 Then
                    sMsgAdd = Me.Parent.Sheets("MsgText").Cells(lRowMsg, 2).Value
                End If
            On Error GoTo errHandler

            sMsg = Target.Validation.InputMessage
            With tbxTemp.TextFrame
                .Characters.Text = sTitle & sMsg & vbLf & sMsgAdd
                .Characters.Font.Bold = False
                .Characters(1, Len(sTitle)).Font.Bold = True
            End With
            tbxTemp.Top = Target.Offset(1, 1).Top
            tbxTemp.Left = Target.Offset(1, 1).Left
            tbxTemp.Visible = msoTrue
            tbxTemp.ZOrder msoBringToFront
        Else
            tbxTemp.TextFrame.Characters.Text = vbNullString
            tbxTemp.Visible = msoFalse
        End If
    End If

errHandler:
    Application.EnableEvents = True

End Sub

Data Validation Input Message workaround 255 char

1 Answers