Macro to check if every row in column E is 6 digit number

[tonywatsonhelp]

Hi Everyone,
I have a document that i need to do some checks on with a macro,
the first macro needs to check if every used row in column E of range (E15:P(last row)) has number in it and that every number is 6 digits long.

the rule are this,
i need to find last row buy finding the last row used in columns E:P but any column could have the last row of data as data can be missing.
once we know what last row is we do this,

go dowm Range E15:E lastrow) check each cell has data in it, if cell is empty them fill it yellow,
for each cell with data in it check if the data is a number 6 digits long (on decimals) only,
if not fill it Red anf font white,
if its correct then fill light green.

if any cells are blank then message box "You have some blank cell in "Account" column please fix each yellow cell before proceeding!"
if any cells are not numbers then message box "You have some incorrect inputs in the "Account" column please fix each red cell before proceeding!"
and if there are both then
message box "You have some incorrect inputs and blank cell in the "Account" column please fix each red and each yellow cell before proceeding!"

please help if you can thanks
Tony

 

[Fluff]

How about

Sub tonyw()
   Dim UsdRws As Long
   Dim Cl As Range
   Dim Blank As Boolean, Short As Boolean
   
   UsdRws = Range("E:P").Find("*", , , xlPart, xlByRows, xlPrevious, , , False).Row
   
   For Each Cl In Range("E15:E" & UsdRws)
      If Cl.Value = "" Then
         Blank = True
         Cl.Interior.Color = vbYellow
      ElseIf Len(Cl.Value) <> 6 Then
         Short = True
         Cl.Interior.Color = vbRed
         Cl.Font.Color = vbWhite
      Else
         Cl.Interior.Color = vbGreen
      End If
   Next Cl
   If Blank And Short Then
      MsgBox "You have some incorrect inputs and blank cell in the Account column please fix each red and each yellow cell before proceeding!"
   ElseIf Blank Then
      MsgBox "You have some blank cell in Account column please fix each yellow cell before proceeding!"
   ElseIf Short Then
      MsgBox "You have some incorrect inputs in the Account column please fix each red cell before proceeding!"
   End If
End Sub

 

[tonywatsonhelp]

OMG, Fluff to the rescue once again,
Thanks very much
Tony

 

[Fluff]

You're welcome & thanks for the feedback.

 

[Rick Rothstein]

Fluff beat me to it... and our code is similar in structure, but his code does not verify that if there are 6 characters in the cell they are all digits. Here is what I wrote (as I said, its approach is similar) which does verify this condition along with the other conditions...

Sub CheckForSixDIgitNumbers()
  Dim Cell As Range, Yellow As Long, Red As Long, Msg As String
  For Each Cell In Range("E15:E" & Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row)
    If Cell.Value = "" Then
      Cell.Interior.ColorIndex = 6
      Yellow = 1
    ElseIf Cell.Value Like "######" Then
      Cell.Interior.ColorIndex = 35
    Else
      Cell.Interior.ColorIndex = 3
      Cell.Font.ColorIndex = 2
      Red = 1
    End If
  Next
  If Yellow + Red = 2 Then
    MsgBox "You have some incorrect inputs and blank cell in the ""Account"" column please fix each red and each yellow cell before proceeding!"
  ElseIf Yellow Then
    MsgBox """Account"" column please fix each yellow cell before proceeding!"
  ElseIf Red Then
    MsgBox "You have some incorrect inputs in the ""Account"" column please fix each red cell before proceeding!"
  End If
End Sub