1

I am trying to restrict the inputs of certain cells in my excel worksheet as follows: 1-7,10,12, which means that only numbers 0 to 9 and symbols - and , can appear in the cell. I would like to ideally handle it in a non-vba based Data validation manner, but even a vba based solution will be ok.

EDIT - There is one keyword which would be an exception, 'Fixed', if I see this word it would be allowed.

Community
  • 1
  • 1
hardikudeshi
  • 1,441
  • 5
  • 18
  • 22

2 Answers2

2

The VBA version using Regex object: I just wrote the function. You can simply call this function within the Sheet change event. (like how Siddharth has used). And one other thing, each time user enters wrong characters, the function deletes them all :D... Then again, you need to be aware that to make sure this operation happens within a particular range of your choice.. coz otherwise it can erase any cell that's being changed!!! Given Siddtharth's post for infinite loops within this `worksheet change event, I have edited the code to include that bit as well.

    Option Explicit

    '-- within sheet change event
    Private Sub Worksheet_Change(ByVal Target As Range)
       On Error GoTo Zoo
       Application.EnableEvents = False
       Call NumbersAndCommaDashOnly(Target)

       GetBack:
       Application.EnableEvents = True
       Exit Sub
   Zoo:
       MsgBox Err.Description
       Resume GetBack
    End Sub

Function NumbersAndCommaDashOnly(ByRef rngInput As Range) As String    
Dim objRegex As Object
Dim strInput As String

Set objRegex = CreateObject("VBScript.RegExp")
objRegex.IgnoreCase = True
objRegex.Global = True
objRegex.Pattern = "^[-,0-9]+$|^[Fixed]$"

If Not IsNull(rngInput.Value) Then
    strInput = rngInput.Value
Else
    NumbersAndCommaDash = "Empty Range"
    rngInput.Value = ""
    Exit Function
End If

If objRegex.Test(rngInput.Value) Then
    NumbersAndCommaDash = objRegex.Replace(rngInput, "")
Else
    NumbersAndCommaDash = "No numbers found"
    rngInput.Value = ""
End If

End Function
  • For an Excel Formula based solution, you may look into this MSDN article.
Community
  • 1
  • 1
bonCodigo
  • 14,268
  • 1
  • 48
  • 91
  • Do i need to do some additional steps to create a `VBScript.RegExp` object? – hardikudeshi Jan 11 '13 at 06:08
  • btw,is it possible to have reg-ex applied via data-validation? – hardikudeshi Jan 11 '13 at 06:11
  • @hardikudeshi MS has not put these into a particular library to be used in VBA.. but you can reference like how I have done in the code for the [Regex objects](http://msdn.microsoft.com/en-us/library/ms974570.aspx#scripting05_topic2) And yes it's possible to have `Regex` via data validation. Try it out on a cell and you will see :D... – bonCodigo Jan 11 '13 at 06:13
  • 2
    + 1 for regex :) however a word of caution :) http://stackoverflow.com/questions/13860894/ms-excel-crashes-when-vba-code-runs/13861640#13861640 (Points 2 and 3) – Siddharth Rout Jan 11 '13 at 06:14
  • @SiddharthRout thanks. I was just updating my post with the `eraser` danger using this... ;) – bonCodigo Jan 11 '13 at 06:20
  • 1
    I was actually taking about switching off events and error handling :) – Siddharth Rout Jan 11 '13 at 06:27
  • 1
    @SiddharthRout sorry mate for getting back late. It's Friday! ;) Thanks. – bonCodigo Jan 11 '13 at 19:14
1

Here is a VBA Approach for just cell A1.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Long

    On Error GoTo Whoa

    Application.EnableEvents = False

    If Not Intersect(Target, Range("A1")) Is Nothing Then
        If Len(Range("A1").Value) <> 0 Then
            For i = 1 To Len(Range("A1").Value)
                Select Case Asc(Mid(Range("A1").Value, i, 1))
                '~~> Check for 0-9, "," and "-"
                Case vbKey0 To vbKey9, 44, 45
                Case Else
                    Range("A1").ClearContents
                    MsgBox "Invalid Value"
                    Exit For
                End Select
            Next
        End If
    End If

Letscontinue:
    Application.EnableEvents = True
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume Letscontinue
End Sub

The code goes in the Sheet1 code area.

enter image description here

Screenshot (Code in Action)

enter image description here

FOLLOWUP to the recent edit in the question

Change the line

If Len(Range("A1").Value) <> 0 Then

to

If Len(Range("A1").Value) <> 0 And _
UCase(Range("A1").Value) <> "FIXED" Then 
Siddharth Rout
  • 147,039
  • 17
  • 206
  • 250
  • I just updated my question, I have one exception "Fixed", so the only change required would be `If (Len(Range("A1").Value) <> 0 And Range("A1".Value) = "Fixed") Then`. Correct? – hardikudeshi Jan 11 '13 at 06:31
  • `If Len(Range("A1").Value) <> 0 And UCase(Range("A1").Value) <> "FIXED" Then` – Siddharth Rout Jan 11 '13 at 06:43