Dynamic array

  • Thread starter Thread starter RipperT
  • Start date Start date
R

RipperT

I am trying to grab missing numbers from a sequence of numbers in an ID
field in a table using a For Next loop that will plug the missing numbers
into dynamic array. I'm working off of Access help. I've tried so many
variations of this trying to get it to work that I can't remember them all,
but here is the latest version. It generates an index out of range error
just before the Redim statement. Can anyone tell me why? Actually getting an
array to work in VBA is my focus right now because I've never been able to
create one that worked. I haven't even given any thought to what I'll do
with my array once it has actual values in it, I just want to get that far
and I'll be happy. Thanks to anyone who can help.

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim lowestID As Long, highestID As Long
Dim i, j

Set db = CurrentDb
Set rs = db.OpenRecordset("qryGrievances")

Dim a() As Variant
With rs
.MoveLast
highestID = !GrievNumber
.MoveFirst
lowestID = !GrievNumber
End With
j = 0
For i = lowestID To highestID
If IsNull(DLookup("GrievNumber", "qryGrievances", "[GrievNumber] = " & i
& "")) Then
Debug.Print i
a(j) = i
ReDim Preserve a(UBound(a) + 1)
j = j + 1
End If
Next

End Function
 
You'd be better off using a collection rather than an array.
Also, I don't believe movefirst and movelast will necessarily get you the
lowest and highest value unless you do a sort first. Does your query do that?
-- David
"Give someone a fish and they eat for a day; teach someone to fish and they
eat for a lifetime".
 
RipperT said:
I am trying to grab missing numbers from a sequence of numbers in an ID
field in a table using a For Next loop that will plug the missing numbers
into dynamic array. I'm working off of Access help. I've tried so many
variations of this trying to get it to work that I can't remember them all,
but here is the latest version. It generates an index out of range error
just before the Redim statement. Can anyone tell me why? Actually getting an
array to work in VBA is my focus right now because I've never been able to
create one that worked. I haven't even given any thought to what I'll do
with my array once it has actual values in it, I just want to get that far
and I'll be happy. Thanks to anyone who can help.

Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim lowestID As Long, highestID As Long
Dim i, j

Set db = CurrentDb
Set rs = db.OpenRecordset("qryGrievances")

Dim a() As Variant
With rs
.MoveLast
highestID = !GrievNumber
.MoveFirst
lowestID = !GrievNumber
End With
j = 0
For i = lowestID To highestID
If IsNull(DLookup("GrievNumber", "qryGrievances", "[GrievNumber] = " & i
& "")) Then
Debug.Print i
a(j) = i
ReDim Preserve a(UBound(a) + 1)
j = j + 1
End If
Next

End Function
Click to expand...

You need to do the Redim before you assign a value to the
array element and UBound doesn't exist the first time
through. Try it this way:

j = 0
For i = lowestID To highestID
If IsNull(DLookup("GrievNumber", "qryGrievances",
"[GrievNumber] = " & i
& "")) Then
Debug.Print i
ReDim Preserve a(j)
a(j) = i
j = j + 1
End If
Next
 
As Dorian says you may be better off using a Collection as you can just add
an item to acollection without worrying about indexes.

But the reason why you routine is failing is that you need to initialise the
array. ReDim A(0) will initialise to 1 element.
So:
....
j = 0
ReDim A(0)
For i = lowestID To highestID
....
However a neater way would be:

j = 0
For i = lowestID To highestID
If IsNull(DLookup("GrievNumber", "qryGrievances", "[GrievNumber] = " & i
& "")) Then
Debug.Print i
ReDim Preserve a(j)
a(j) = i
j = j + 1
End If
Next

Also whether you use a Collection or an Array, DLookup will be very slow if
your qryGrievances is of any size so you would be better off just looping
through your recordset. Something like this (not tested):

Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("qryGrievances")
If Not rs.EOF Then
Dim a() As Long
Dim L As Long
ReDim a(0)
With rs
.MoveFirst
L = !GrievNumber
.MoveNext
Do Until .EOF
If !GrievNumber > L + 1 Then
Do Until L = !GrievNumber
L = L + 1
Debug.Print L
a(UBound(a)) = L
ReDim Preserve a(UBound(a) + 1)
L = L + 1
Loop
Else
L = !GrievNumber
End If
.MoveNext
Loop
End With
End If

HTH
 
Back
Top