Excel Data Validation to allow formulas but not numbers?

I would like to allow a user to enter these value into a cell:
  "x"
  "!"
 "Comp"
  any formula starting with "=row("
However, the user can not be allowed to enter any number directly, say "5", "16".

Alternatively, if the user can enter anything (including formulas resulting in a number) into the cell, BUT he can not enter plain numbers directly, then that would work just as well.

Is there a way?
EtceAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Patrick MatthewsCommented:
Hello Etce,

You can use the Change event on the worksheet you need watched to do this. Please add the code in the
snippet below to the sheet module for the worksheet you need "watched", and be sure that macros are
enabled. I have assumed that the range you need this applied to is Column A starting in Row 2 and continuing
as far down as desired, but this is changeable.

Regards,

Patrick
Option Explicit
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim cel As Range
    Dim MsgText As String
    Dim FoundOne As Boolean
    
    With Me
        If Not Intersect(Target, .UsedRange, .Range("a2", .Cells(.Rows.Count, "a"))) Is Nothing Then
            Application.EnableEvents = False
            FoundOne = False
            MsgText = "The following cells had problems, and have had their contents cleared:" & vbCrLf
            For Each cel In Intersect(Target, .UsedRange, .Range("a2", .Cells(.Rows.Count, "a"))).Cells
                If cel.HasFormula Then
                    If Not cel.Formula Like "=ROW(*" Then
                        MsgText = MsgText & vbCrLf & cel.Address(False, False) & " : Bad formula " & _
                            Left(cel.Formula, 20) & IIf(Len(cel.Formula) > 20, "...", "")
                        cel.ClearContents
                        FoundOne = True
                    End If
                Else
                    Select Case UCase(cel.Value)
                        Case "X", "!", "COMP"
                            'do nothing
                        Case Else
                            MsgText = MsgText & vbCrLf & cel.Address(False, False) & " : Bad value " & _
                                Left(cel.Value, 20) & IIf(Len(cel.Value) > 20, "...", "")
                            cel.ClearContents
                            FoundOne = True
                    End Select
                End If
            Next
            Application.EnableEvents = True
            If FoundOne Then MsgBox MsgText, vbCritical, "Invalid Entry"
        End If
    End With
    
End Sub

Open in new window

0
Patrick MatthewsCommented:
On second thought, I like this one better...
Option Explicit
Option Compare Text
 
Private Sub Worksheet_Change(ByVal Target As Range)
    
    Dim cel As Range
    Dim MsgText As String
    Dim FoundOne As Boolean
    Dim ClearRng As Range
    
    With Me
        If Not Intersect(Target, .UsedRange, .Range("a2", .Cells(.Rows.Count, "a"))) Is Nothing Then
            Application.EnableEvents = False
            FoundOne = False
            MsgText = "The following cells had problems, and have had their contents cleared:" & vbCrLf
            For Each cel In Intersect(Target, .UsedRange, .Range("a2", .Cells(.Rows.Count, "a"))).Cells
                If cel.HasFormula Then
                    If Not cel.Formula Like "=ROW(*" Then
                        MsgText = MsgText & vbCrLf & cel.Address(False, False) & " : Bad formula " & _
                            Left(cel.Formula, 20) & IIf(Len(cel.Formula) > 20, "...", "")
                        If ClearRng Is Nothing Then
                            Set ClearRng = cel
                        Else
                            Set ClearRng = Union(ClearRng, cel)
                        End If
                        FoundOne = True
                    End If
                Else
                    Select Case UCase(cel.Value)
                        Case "X", "!", "COMP"
                            'do nothing
                        Case Else
                            MsgText = MsgText & vbCrLf & cel.Address(False, False) & " : Bad value " & _
                                Left(cel.Value, 20) & IIf(Len(cel.Value) > 20, "...", "")
                            If ClearRng Is Nothing Then
                                Set ClearRng = cel
                            Else
                                Set ClearRng = Union(ClearRng, cel)
                            End If
                            FoundOne = True
                    End Select
                End If
            Next
            If FoundOne Then
                MsgBox MsgText, vbCritical, "Invalid Entry"
                ClearRng.ClearContents
            End If
            Application.EnableEvents = True
        End If
    End With
    
End Sub

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
EtceAuthor Commented:
Thank you, that does exactly what I asked - been trying it out now.  It does come with a side-effect though, in that it effectively removes Excel's Undo feature, or at least so it would seem from my testing.  Any way to avoid that?
0
Patrick MatthewsCommented:
Etce said:
>>It does come with a side-effect though, in that it effectively removes Excel's Undo feature, or at least so it
>>would seem from my testing.  Any way to avoid that?

Not really.  VBA code wipes out the undo buffer.  VBA giveth, and VBA taketh away...
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.