CODEWITHSUNDEEP
vbams-access
CPM
CPM

Reputation: 15

MS Access: Validate data in tables using VBA

Ok, I asked this question in another post but it became too messy...

Here is what I would like to do...

First, there is a table called Age where the user enters age ranges, and there can be multiple age ranges entered into the table... In field names in the table are "MinAge" and "MaxAge".

I have a toggle button whereby the user validates the data to ensure four things:

  1. That there aren't any null fields in the table
  2. That the MaxAge is greater than the MinAge for each row
  3. That the MaxAge on a row is greater than the Min age on the previous row...
  4. That the Min Age on a row is sequentially by one than the Max Age on the next row

Some examples

- Min Age Max Age ROW 1: 0 5 ROW 2: 6 8

PASS because Min age is > than Max age for each row, Min age on row 2 is > than max age on row 1, and Min age on row 2 is sequentially greater by 1 than the max age on row 1.

          Min Age    Max Age
   ROW 1:               5
   ROW 2:   6

FAIL because there are null values in row 1 and 2

          Min Age    Max Age
   ROW 1:   10           5
   ROW 2:   6            8

FAIL because the Min Age is greater than the Max age in row 1

         Min Age    Max Age
   ROW 1:   0            5
   ROW 2:   4            8

FAIL because the Min Age on Row 2 is less than the Max age on row 1.....

Upvotes: 0

Views: 134

Answers (1)

Doug Coats
Doug Coats

Reputation: 7127

I would handle it within an array. Seems pretty straight forward past that

Dim i as long, j as long, z as long q as long
Dim arr As Variant
Dim arr2() As String, strMsg as string
Dmi rs as recordset
Dmim errBool as Boolean

set rs = CurrentDb.OpenRecordset("your query statement")
With rs
    rs.MoveLast
    q = rs.RecordCount
    rs.MoveFirst
    z = rs.Fields.Count
End With

ReDim xaRR(q, z)  
arr = rs.GetRows(q)

For j = LBound(arr, 2) To UBound(arr, 2)
    For i = LBound(arr, 1) To UBound(arr, 1)
        arr2(j, i) = arr(i, j)
    Next i
Next j

errBool = True
for i = lbound(arr2,1) to ubound(arr2,1)
    if i > 0
        If arr2(i,0)= arr2(i-1,1)+1 then 
            errBool = false
            strMsg = "Start point isnt an increment by 1 of the last position"
        end if 
        if (IsNull(arr2(i,0)) Or (IsNull(arr2(i,0))) = True Then 
            errBool = false
            strMsg = "You have null values"
        End if
        If arr2(i,0) > arr2(i,1) then 
            errBool = False
            strMsg = "You min is larger than your max for row " & i
        End
    end if
next i

if errBool = False then
    MsgBox strMsg
End if 

rs.Close
Set rs = Nothing

Upvotes: 1

Related Questions