Excel: Characters Must Be in List

Hi; Is there anyway to modify this code, to check to make sure that a formatted text column cell has 7 characters out of the basic number list (0 to 9), and no alpha characters? I had to make Column A text, due to some Employee ID numbers containing a lead ZERO, if it's changed to Numeric it will cause a problem. Presently, this code does not work well with a text formatted column, Pasting in data got around my validations, but I changed the format to allow for that, so now this code hosts a few problems. 1. even though I am forcing a Paste Special Values only, it generated a Run-time error '13': Type mismatch, until I placed this in the code: On Error Resume Next Now, everything that is pasted in turns red, even using the forced Paste Special. Folks can either type in entries manually, or they cheat and paste entries in, which made me try to put this together. :-( Private Sub Worksheet_Change(ByVal Target As Range) 'MsgBox Target.Address If Intersect(Target, Range("A2:A65000")) Is Nothing Then Exit Sub On Error Resume Next If Target <> "" Then Application.EnableEvents = False Call CleanTrimCells_Looping Application.EnableEvents = True If Target <> "" Then If Len(Target) <> 7 Then MsgBox ("The Employee ID must be 7 numbers long. Please re-enter a valid Employee ID.") Target.Font.ColorIndex = 3 ElseIf Not IsNumeric(Target) Then MsgBox ("The Employee ID must be entered using numbers only. Please re-enter a valid Employee ID.") Target.Font.ColorIndex = 5 Exit Sub End If End If End If End Sub ************************************************************************************** Sub CheckValidation() Dim cell As Range, bErr As Boolean For Each cell In ActiveSheet.UsedRange If Not cell.Validation.Value Then cell.Select bErr = True MsgBox cell.Address(False, False) & " fails validation criteria" End If Next If Not bErr Then MsgBox "All cells OK" End Sub ********************************************************************************************* Sub CleanTrimCells_Looping() Dim cell As Range Dim lastRow As Long Dim rng As Range Application.EnableEvents = False 'Weed out any formulas from selection If Selection.Cells.Count = 1 Then lastRow = Cells(Rows.Count, "A").End(xlUp).Row Set rng = Range("A2:A" & lastRow) Else Set rng = Selection.SpecialCells(xlCellTypeConstants) End If 'Trim and Clean cell values For Each cell In rng.Cells cell.Value = Application.WorksheetFunction.Clean(Application.WorksheetFunction.Trim(cell.Value)) 'cell.Value = Application.WorksheetFunction.Trim(cell.Value) Next cell Application.EnableEvents = True End Sub

This question generated 12 answers. To proceed to the answers, click here.

This thread is current as of May 11, 2017.

For more resources for Microsoft Excel