Validation of text cells through Code

[6afraidbecause789]

HI - I'd like to make validation through code. However, the cells are
textual, not numeric. For instance, the cells in the range must only
hold a single zero 0 or any 3-digit combination of numbers from 1
through 4, such as 111, 234, 420, 444. Anything like 454, 12345,
4444, etc. must be caught. Any help on this would be greatly
appreciated.

Also, it would be great if the code auto corrected a user's mistake.
If someone entered a 2222, Excel would correct it to 222; if someone
entered 434444, Excel would take of the trailing 4s and make it 434.

Thanks again

 

[Rick Rothstein]

Something like this maybe...

Number = Left(Number, 3)
If Number Like "[0-4][0-4][0-4]" And Not Number Like "*0*0*" Then
' That is a valid number
Else
' That number is not valid
End If

 

[6afraidbecause789]

Thanks Rick,

I'll try it out in a bit.

 

[6afraidbecause789]

The cells are still accepting 3-digit combinations with numbers
greater than 4 (like 555, 426, 777). What code could block the entry
of numbers greater than 4?


Private Sub Worksheet_Change(ByVal Target As Range)

Dim myRngToInspect As Range
Dim myIntersect As Range
Dim myCell As Range

Set myRngToInspect = Me.Range("au13:ez100")

Set myIntersect = Intersect(Target, myRngToInspect)

If myIntersect Is Nothing Then
Exit Sub
End If

On Error Resume Next 'just fly by errors
Application.EnableEvents = False
For Each myCell In myIntersect.Cells

myCell = Left(myCell, 3)
If myCell Like "[0-4][0-4][0-4]" And Not myCell Like "*0*0*" Then
' That is a valid number
Else
' That number is not valid
End If

If myCell.Value Like "#" Then
myCell.Value = String(3, CStr(myCell.Value))
End If
Next myCell
Application.EnableEvents = True
On Error GoTo 0

End Sub

======================

Thanks

 

[Rick Rothstein]

You are not taking any action against a bad entry, so it remains. Consider
something like this...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myCell As Range
Dim myIntersect As Range
Set myIntersect = Intersect(Target, Me.Range("au13:ez100"))
If myIntersect Is Nothing Then Exit Sub
On Error Resume Next 'just fly by errors
Application.EnableEvents = False
For Each myCell In myIntersect.Cells
myCell = Left(myCell, 3)
If myCell Like "[0-4][0-4][0-4]" And Not myCell Like "*0*0*" Then
myCell.Value = String(3, CStr(myCell.Value))
Else
'
' I'm not sure what action you want to take when an invalid
' entry is made, but whatever you want to do, it should be
' done here. My example suggestion is to delete the entry.
'
myCell.Value = ""
End If
Next myCell
Application.EnableEvents = True
On Error GoTo 0
End Sub

 

[6afraidbecause789]

Thanks Rick