VBA Verifying Data

[KX13ZN]

I have had a look around for a way to check that the data stored in a range is only numbers or is blank. However nothing matches what I need...at least in VBA, which is what I need.
The range can be anywhere between A1 to D65000. The data will always end up in the first 4 columns.


Theoretically, in column A there should only be whole numbers between 1 and 999,999,999 (there whole range isn't present but values can go that high) and blank cells.

However if something has gone wrong in a previous process then the cells may contain dates or letters or both as well as numbers.
I've tried using data validation within excel but that doesn't check existing data if applied after the fact and because the data moves around on the sheet setting it before hand or setting cell formatting before isn't practical.
And IsNumber or IsNumeric require the cells to be formatted to work properly...as far as I can tell.

So unless excel has auto formatted a cell to be something specific, then all the cells are formatted as general.

So I need to way to check that just the numbers 0,1,2,3,4,5,6,7,8,9 are present and that its not a date.

I then need to check if all cells in Column B contain letters, but these are names so they contain spaces and accented letters, just not numbers, period or commas

I also need to check that Column C only contains capital Letters, so A-Z only, or be blank
Has to be case sensitive.

And then lastly Column D should only contain dates or be blank

1​	name one	AAAA	22/01/2020​
22​	name two	BBBB	21/01/2020​
333​	name threé	CCCC	20/01/2020​
4444​	name four	DDDD	19/01/2020​
55555​	name fivé	EEEE	18/01/2020​
666666​	name six	FFFF	17/01/2020​
7777777​	name seven	GGGG	16/01/2020​
88888888​	name eight	HHHH	15/01/2020​
999999999​	name nine	IIIII	14/01/2020​

If any errors are found then it just needs to output a msgbox and then run some other code because it means a previous process has gone wrong and things need to start again.

I've never worked directly with data checking so I'm completely new to this.
Help would be great but I also want to learn how to do this in the future as i'm sure i'll need to check otherthing later on.

 

[Sunjinsak]

You're welcome. Glad we could help

As for DoEvents yes, absolutely. Put it after the first line of the loop like so...

    'Loop through each 'column' in the array...
    For col = 1 To UBound(DataArray(), 2)

    DoEvents

        'Loop through each 'row' in the 'column'...
        For row = 1 To UBound(DataArray(), 1)

        '...

 

[Yongle]

I also tried your code on my data @Yongle and it works fine, all the checks throw out the errors in the correct place, it also runs pretty quickly. I also can't however get it to work without having the sheet selected. I need it to effectively run in the background. I tried editing the 'with activesheet' but for some reason that was not enough to change where the code runs, do i have to add a sheet reference to every mention of cells?

=CELL("format",D2) provides an easy way to get at the cell format to see if Excel has formatted D2 as a date

But if the workbook is not active because you are playing in another workbook, the formula needed is
=CELL("format",'[Workbook Name]Name of Sheet'!D2)

The only tricky bit is that 2 lines using Evaluate require amending so that the string includes the workbook and sheet reference
Evaluate("CELL(" & Chr(34) & "Format" & Chr(34) & ",D" & x & ")")

I will post an update tommorrow

 

[Yongle]

Amended code as promised
Amend the name of the worksheet in this line
Const sh = "Name of Sheet"

Sub Verify()
    Const sh = "Name of Sheet"          ' amend sheet name
    Const r = 2                         ' the first row to check for value
    Const V = vbCr & vbCr
    Dim A, B, C, D, x As Long, Rng As Range, Msg As String, valueD As Date, f As String, formula As String
CreateArrays:
    With ThisWorkbook.Sheets(sh)
        Set Rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
    End With
    A = Rng
    B = Rng.Offset(, 1)
    C = Rng.Offset(, 2)
    D = Rng.Offset(, 3)
ModelFormula:
    formula = "CELL(" & Chr(34) & "Format" & Chr(34) & ",'[" & Rng.Parent.Parent.Name & "]" & Rng.Parent.Name & "'!@@)"
ColumnA:
    On Error Resume Next
    For x = r To UBound(A)
        f = Replace(formula, "@@", "A" & x)
            If CLng(Val(A(x, 1))) <> A(x, 1) Then
                Msg = "Bad integer" & V & A(x, 1): GoTo Handling
            ElseIf Evaluate(f) Like "D*" Then Msg = "Formatted as date " & V & Cells(x, 1).Address(0, 0): GoTo Handling
            End If
    Next x
    On Error GoTo 0
ColumnB:
    For x = r To UBound(B)
        If B(x, 1) Like "*[0-9]*" Or B(x, 1) Like "*,*" Or B(x, 1) Like "*.*" Then Msg = "Bad Name" & V & B(x, 1): GoTo Handling
    Next x
ColumnC:
    For x = r To UBound(C)
        If UCase(C(x, 1)) <> C(x, 1) Then Msg = "Not Upper Case" & V & C(x, 1): GoTo Handling
        If C(x, 1) Like "*[0-9]*" Or C(x, 1) Like "*,*" Or C(x, 1) Like "*.*" Then Msg = "Not Upper Case" & V & C(x, 1): GoTo Handling
    Next x
ColumnD:
    On Error Resume Next
    formula = Replace(formula, "A@", "D@")
    For x = r To UBound(D)
        f = Replace(formula, "@@", "D" & x)
        If D(x, 1) <> "" And Left(Evaluate(f), 1) <> "D" Then Msg = "Bad date" & V & Cells(x, 4).Address(0, 0): GoTo Handling
    Next x
    On Error GoTo 0
Exit Sub
Handling: MsgBox "Row " & x & V & Msg, vbExclamation, ""
End Sub

 

[Yongle]

Despite an inconsistency, the code in post#13 correctly evaluates variable f further down (which is why I did not spot it )
But ONE line of the code requires a tiny amendment as below

ColumnD:
'this line
formula = Replace(formula, "A@", "D@")
'should be amended to
formula = Replace(formula, "A@", "@@")