Data Validation Input Message Hack - Help Needed

[lmoseley7]

I wanted to see if we could make cell comments dynamic based upon a formula or cell value, etc. I found a short video of Mr. Excel attempting the same and he said he never found a way to do it within the cell comment but he then showed some code that would allow a comment-like window to pop up when he clicked on a specific cell. Although he didn't explain it very fully, I was able to tell from the title of the video that it must have something to do with data validation's input message screen. He never mentions setting up the data validation to begin with or if there is any code behind the cell he clicks on. I built a working bit of code, but the calculation event wasn't what I needed to trigger it, I really wanted it to be triggered on a selection change. I'm using a VLOOKUP formula to return the string that accompanies the cell value that has been clicked on. If the cell does not have data validation on it, the code should end without doing anything.

I was finding it hard to debug a selection change, without actually changing my selections so I made a few adjustments (e.g. removing 'ByVal Target As Range') and saved the code in a normal module, not the sheet module so that I could step through the code. I was getting an error on the following line:

Worksheets("Sheet1").selcell.Validation.InputMessage =descr

that stated, "Object doesn't support this property or method". I figured the issue was with selcell, so I changed that line to read:

Worksheets("Sheet1").Range("A28").Validation.InputMessage = descr

and that worked.

In the code below, what changes would I need to make so that this code would work with any selected cell in Sheet1?

Another note, when I hover over 'selcell' in the code, the tool tip shows the value '8' which is what is in the cell, but I set selcell up as a Range, so should it be showing me the address and not the value? Is that the issue?

Sub Test_SelectionChange()

Dim luValue As Variant
Dim tblArray As Range
Dim colIndex As Integer
Dim descr As String
Dim Wb As Workbook: Set Wb = ActiveWorkbook
Dim WS As Worksheet: Set WS = Wb.Sheets("Sheet1")
Dim selcell As Range
Dim r As Range
Set tblArray = WS.Range("A1:D16")
colIndex = 4
Set selcell = ActiveCell
luValue = selcell.Value
Set r = Cells.SpecialCells(xlCellTypeAllValidation)
    If Not Application.Intersect(r, selcell) Is Nothing Then
        If IsNumeric(luValue) Then
descr = WorksheetFunction.VLookup(luValue, tblArray, colIndex, False)
            'Worksheets("Sheet1").selcell.Validation.InputMessage = descr
            Worksheets("Sheet1").Range("A28").Validation.InputMessage = descr
        End If
    Else: GoTo ErrorMessage
ErrorMessage:
    MsgBox "Error"
    End If
End Sub

 

[lmoseley7]

In case anyone else comes across this thread, or I do at a later date, I'm updating this thread with the code that I eventually got to work. A few of the changes I'd point out from the previous code are:

My tblArray range was updated to lock the range with absolute references

WS.Range("$A$1:$D$16)

.

I declared a Validation type variable 'dval' and set it equal to the Validation of the selected cell 'selcell'. This cleared the issue I was having trying update the validation input message by trying to mix a worksheet reference with a range declared in VBA. I'm guessing that was at least part of the issue. Normally when I've sucessfully used

Worksheets("Sheet1").Range()

the range mentioned was either a cell reference, a range reference using cell addresses or a named range within the worksheet. By declaring the validation as an object (i guess?) I was able to update data within the input message without confusing Excel as to what I was attempting to update.

Here is my updated code. It accurately displays 'tool-tip" information only for cells with data validation that also are numeric.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim luValue As Variant
Dim tblArray As Range
Dim colIndex As Integer
Dim descr As String
Dim Wb As Workbook: Set Wb = ActiveWorkbook
Dim WS As Worksheet: Set WS = Wb.Sheets("Sheet1")
Dim selcell As Range
Dim r As Range
Dim dVal As Validation


Application.EnableEvents = False
Set tblArray = WS.Range("$A$1:$D$16")
colIndex = 4
Set selcell = ActiveCell
luValue = selcell.Value
Set r = Cells.SpecialCells(xlCellTypeAllValidation)
Set dVal = selcell.Validation
    If Not Application.Intersect(r, selcell) Is Nothing Then
        If IsNumeric(luValue) Then
descr = WorksheetFunction.VLookup(luValue, tblArray, colIndex, False)
            dVal.InputMessage = descr
        End If
    Else: GoTo ErrorMessage
ErrorMessage:
    End If
Application.EnableEvents = True


End Sub