MS Access Consolidating Ranges of Numbers - ms-access

Question

I want to be able to collapse multiple contiguous ranges into as few ranges as possible.
I have already been able to do this in Excel by using a macro to paste formulas into adjacent cells. I know I can accomplish this similarly using a recordset and iterating through the data calculating formulas as I go, but I hope that someone knows a simpler more efficient way to do this so that it is not impractical to do with larger data sets.
Here is a sample of the data I am working with:
Origin Low High Dest
SDF 40200 40309 EWR
SDF 40310 40370 EWR
SDF 70000 70800 ORD
SDF 40371 40402 EWR
SDF 40508 40580 EWR
... and the desired output of the process would be:
Origin Low High Dest
SDF 40200 40402 EWR
SDF 40508 40580 EWR
SDF 70000 70800 ORD

Answer 1

You would need to open an ordered recordset using VBA and iterate over each record, testing whether the differences between the High of one record and Low of the next differs by more than one.
In draft code, this might look like the following (where SourceTable is the source table, and DestTable is an existing table which may be used to store the output):
Function ConsolidateRanges()
Dim dbs As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim org As String
Dim low As Long
Dim hig As Long
Dim des As String
Set dbs = CurrentDb
Set rs1 = dbs.OpenRecordset("select * from SourceTable order by origin, dest, low, high")
If Not rs1.EOF Then
dbs.Execute "delete from DestTable"
Set rs2 = dbs.OpenRecordset("DestTable")
rs1.MoveFirst
GetRange rs1, org, low, hig, des
rs1.MoveNext
Do Until rs1.EOF
If org <> rs1!origin Or des <> rs1!dest Or rs1!low - hig > 1 Then
AddRange rs2, org, low, hig, des
GetRange rs1, org, low, hig, des
Else
hig = rs1!high
End If
rs1.MoveNext
Loop
AddRange rs2, org, low, hig, des
rs2.Close
End If
rs1.Close
End Function
Function GetRange(rstIn As Recordset, strOrg As String, lngLow As Long, lngHig As Long, strDes As String)
With rstIn
strOrg = .Fields("Origin")
lngLow = .Fields("Low")
lngHig = .Fields("High")
strDes = .Fields("Dest")
End With
End Function
Function AddRange(rstOut As Recordset, strOrg As String, lngLow As Long, lngHig As Long, strDes As String)
With rstOut
.AddNew
.Fields("Origin") = strOrg
.Fields("Low") = lngLow
.Fields("High") = lngHig
.Fields("Dest") = strDes
.Update
End With
End Function