Add input message via data validation to all cells that are selected

I expect an Input Message with a title when a cell is clicked.

I can't achieve this with the VBA code that I have.

Sub SelectAllNonBlankCells()
    Dim objUsedRange As Range
    Dim objRange As Range
    Dim objNonblankRange As Range

    Set objUsedRange = Application.ActiveSheet.UsedRange

    For Each objRange In objUsedRange
        If Not (objRange.Value = "") Then
           If objNonblankRange Is Nothing Then
              Set objNonblankRange = objRange
           Else
              Set objNonblankRange = Application.Union(objNonblankRange, objRange)
           End If
        End If
    Next

    With objNonblankRange.Validation
        .Delete
        .Add Type:=xlValidateCustom, Operator:=xlEqual, Formula1:="="""
        .IgnoreBlank = True
        .InputTitle = "Title"
        .InputMessage = "Enter message"
    End With

End Sub