Data Validation

[ragamuffin]

Hi,

I have a scan sheet that I need to validate so that cells E8:AP308 will only allow numeric characters eleven digits in length. That is, spaces, decimal points, and letters should not be allowed into the cells even if they add up to eleven characters. This is to scan serial numbers for inventory purposes, so anything that falls outside of the criteria needs to be flagged. I know that there is an error check feature in excel, but I am not familiar with it. I need the most user friendly way to allow someone to scan several hundred items and to notice their mis-scans either (1) as each one comes along or (2) at the end of the scanning process so that all mis-scans are highlighted or circled in red or something to that effect so that they can go back and correct them accordingly - I am leaning toward option #2, so that the scan can be done in one lump process and then the corrections in one lump process, but I am open to suggestions. I am also leaning towards a data validation if at all possible, but a macro with button may work well too.

My sheet is attached. There are two tabs which are basically the same thing, one for a sellable location and the other for a return location. The validation or macro should work the same on both sheets, but independent of each sheet.

Any help with this would be greatly appreciated!

Thanks for any and all help!

rm

[Bob Phillips]

You could use Data Validation with a type of Decimal and values of -99999999999 and 99999999999 or contional formatting with a formula of =AND(ISNUMERIC(E8),LEN(E8)=11) (or both)

[rbrhodes]

Hi rm,

This one cleans the range of anything but 0 to 9.


Option Explicit

Sub Clean()

Dim r As Long
Dim cel As Range
Dim rng As Range

Set rng = Range("E8:AP308")

'speed
Application.ScreenUpdating = False

'kill all except 0 to 9
With rng
For r = 32 To 38
.Replace What:=Chr(r), Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False
Next r
'Chr(39) ' (special)
.Replace What:="~'", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
For r = 40 To 41
.Replace What:=Chr(r), Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False
Next r
'Chr(42) * (special)
.Replace What:="~*", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
For r = 43 To 47
.Replace What:=Chr(r), Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False
Next r
'48 to 57 = 0 to 9
For r = 58 To 62
.Replace What:=Chr(r), Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False
Next r
'Chr(63) ? (special)
.Replace What:="~?", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
For r = 64 To 125
.Replace What:=Chr(r), Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False
Next r
'Chr(126) ~ (special)
.Replace What:="~~", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
For r = 127 To 255
.Replace What:=Chr(r), Replacement:="", LookAt:=xlPart, SearchOrder:= _
xlByRows, MatchCase:=False
Next r

'optional: Do not use if setting Conditional format manually!!!
' .FormatConditions.Delete

End With

'go home
Range("E8").Select

'reset
Application.ScreenUpdating = True

End Sub




OLD: This one is buggy and I don't know why yet! I suggest you just set the conditional formatting of Range("E8") to Formula is =OR(Len(E8)>11,Len(E8)<11). Copy that cell and do a pastespecial to the rest of the range.

EDIT: Conditional formatting requires selection or it will not put address in correctly. This version works correctly.


Sub ScanCheck()

Dim rng As Range
Dim goHome As String

'CHANGE TO SUIT
Set rng = Range("E8:AB308")

'speed
Application.ScreenUpdating = False

'come back here
goHome = ActiveCell.Address

'Can't be done without select!
rng.Select

With Selection
'kill old
.FormatConditions.Delete
'put formula
.FormatConditions.Add Type:=xlExpression, Formula1:= _
"=or(len(" & rng.Address(0, 0) & ")<11,len(" & rng.Address(0, 0) & ") >11)"
'put format
.FormatConditions(1).Interior.ColorIndex = 3
.ColumnWidth = 11.5
End With

'return
Range(goHome).Select

'cleanup
Set rng = Nothing

'reset
Application.ScreenUpdating = True

End Sub


Cheers,

dr


http://www.members.shaw.ca/excelvba