Checking Numbers

[SRN]

Hi,

I've just started to learn VB, my problem is i have a table that has a key of Number, in the table there are 25000 records but the last number is 99999. What i need to do is write a piece of code that will identify the numbers that don't exsist in the table, so therefore i should end up with a table with 74999 unique records.

Can anyone help???

 

[dcx693]

Interesting question. What do you want to do with the results? Meaning, what do you need to do with the list of numbers that don't exist?

You can write some code to loop through your table, check for the existence of each number, and write the nonexistent ones to another table. Hopefully the Number field is a primary key field so you can use the fast Seek method.

I'll work on it a bit and post the code if you want to go that route. Perhaps there is some really clever query you can run, but I can't think of it.

 

[dcx693]

OK, here's the code. It assumes you're using ADO (not DAO), that your data table is called tblNumbers with a "Number" field that is set as a primary key, and that you want to write the non-existent numbers to a table called tblNumbersNotUsed that has a column called "Number". Note that this function will not check numbers starting at 1. It looks for the first value in the Number field and starts from there. That's easily changed.

Sub FindNonExistentNumbers()
Dim rst1 As ADODB.Recordset
Dim rst2 As ADODB.Recordset
Dim lngMinNumber As Long, lngMaxNumber As Long
Dim lngTest As Long
Dim lngCounter As Long

  Set rst1 = New ADODB.Recordset
  Set rst2 = New ADODB.Recordset

  rst1.Open "tblNumbers", CurrentProject.Connection, adOpenKeyset, _
    adLockOptimistic, adCmdTableDirect
  rst2.Open "tblNumbersNotUsed", CurrentProject.Connection, adOpenKeyset, _
    adLockOptimistic, adCmdTableDirect

  rst1.MoveLast
  lngMaxNumber = rst1.Fields("Number")
  rst1.MoveFirst
  lngMinNumber = rst1.Fields("Number")

  rst1.Index = "PrimaryKey"

  For lngCounter = lngMinNumber + 1 To lngMaxNumber
  rst1.Seek lngCounter, adSeekFirstEQ
    If rst1.EOF Then
    'Number not found
      With rst2
        .AddNew
        .Fields("Number") = lngCounter
        .Update
      End With
    End If
  Next lngCounter

  rst1.Close
  rst2.Close
End Sub

 

[SRN]

dcx693,

Thanks,

Yes ideally i would like to create another table that would hold the numbers.

To answer your question about what i am doing with the numbers that don't exsist.
I am creating unique barcodes. For some reason the exsisting software would create a number at random then through a serious of steps would create a barcode. I have all that working but need to get the numbers in the exsisting table that are not being used.

Appreciate it, if anyone can help

 

[dcx693]

The code above assumes you already have a table called tblNumbersNotUsed to hold those numbers that are not being used. It's easy to create a new table in code, but you can just create an empty table, call it tblNumbersNotUsed, create a single field in it called "Numbers" and save it. The program will then work.

By the way, the code is in ADO so it will only work in Access 2000 or higher.

 

[SRN]

Code for Numbers

the following code works.

Sub FindNonExisttentNumbers()
Dim rst1 As DAO.Recordset
Dim rst2 As DAO.Recordset
Dim lngMinNumber As Long, lngMaxNumber As Long
Dim lngTest As Long
Dim lngCounter As Long
Set db = CurrentDb

Set rst1 = db.OpenRecordset("tblnumbers")
Set rst2 = db.OpenRecordset("tblnumbersnotused")


rst1.Index = "PrimaryKey"
rst1.MoveLast
lngMaxNumber = rst1.Fields("Number")
rst1.MoveFirst
lngMinNumber = rst1.Fields("Number")



For lngCounter = lngMinNumber + 1 To lngMaxNumber
rst1.Seek "=", lngCounter
If rst1.NoMatch Then
'Number not found
With rst2
.AddNew
.Fields("Number") = lngCounter
.Update
End With
End If
Next lngCounter

rst1.Close
rst2.Close
End Sub

 

[fmm]

Here's another one. Not exactly what you want, but it produces "Gap Reports".

It assumes the field checked is numeric.

It doesn't care if there are duplicates of the checked field.

It populates a table with 3 fields:
GapBegin (always populated)
GapNote (populated if the gap is bigger than 1)
GapEnd (as GapNote).
Records would look like:
14
27 ---through--- 31

It's fired from a button cmdGapReport.


Private Sub cmdGapReport_Click()
On Error GoTo Err_cmdGapReport_Click

Dim dbs As Database
Dim rst1 As Recordset
Dim rst2 As Recordset
Dim dblGapBegin As Double
Dim dblGapEnd As Double
Dim stGapNote As String


stGapNote = "-through-"
DoCmd.OpenQuery "qryResetGapNumeric" 'deletes all records from dbo_tblGapsNumeric
Set dbs = CurrentDb
DoCmd.SetWarnings False
Set rst1 = dbs.OpenRecordset("qryGapSource") 'a select query returning the field (MyField) to be checked, indexed ascending
DoCmd.SetWarnings True
Set rst2 = dbs.OpenRecordset("dbo_tblGapsNumeric", dbOpenDynaset, dbSeeChanges)


rst1.MoveFirst

With rst1
dblGapBegin = !MyField
End With
rst1.MoveNext

Do While rst1.EOF = False
With rst1
If dblGapBegin <> !MyField And dblGapBegin + 1 <> !MyField Then
' not a dup, not next in sequence
' check for |gap| > 1
If dblGapBegin + 2 <> !MyField Then
' big gap (> 2)
dblGapEnd = !MyField - 1

With rst2
.AddNew
!GapBegin = dblGapBegin + 1
!GapNote = stGapNote
!GapEnd = dblGapEnd
.Update
End With

Else
'|gap| = 1

With rst2
.AddNew
!GapBegin = dblGapBegin + 1
!GapNote = ""
!GapEnd = Null
.Update
End With
End If
End If
dblGapBegin = !MyField
End With
rst1.MoveNext
Loop

rst1.Close
rst2.Close
dbs.Close



Exit_cmdGapReport_Click:
Exit Sub

Err_cmdGapReport_Click:
MsgBox Err.Description
Resume Exit_cmdGapReport_Click

End Sub


Basically, it store the current value. If the current value + 1 <> next value, you have a gap starting at current value + 1.

If current value + 2 = next value, the size of the gap is 1. If not, then the gap ends at next value - 1.