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