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

tonywatsonhelp

Well-known Member
Joined
Feb 24, 2014
Messages
2,932
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,064
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
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

Well-known Member
Joined
Feb 24, 2014
Messages
2,932
Office Version
  1. 365
  2. 2019
  3. 2016
Platform
  1. Windows
OMG, Fluff to the rescue once again,
Thanks very much :)
Tony
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
66,064
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Rick Rothstein

MrExcel MVP
Joined
Apr 18, 2011
Messages
37,561
Office Version
  1. 2019
  2. 2010
Platform
  1. Windows
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...
VBA Code:
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
 

Forum statistics

Threads
1,148,370
Messages
5,746,299
Members
424,006
Latest member
Metal_warrior

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top