Login/Register
Difficult grouped report from database
Asked Answered
sqlvbams-accessms-access-2010
S

1

7
ID  |  Start of range | End of range
------------------------------------
ID1 |  Ok-000001      | Ok-000009
ID1 |  Ok-000010      | Ok-000014
ID1 |  Ok-000015      |
ID1 |  Ok-000016      | Ok-000018
ID1 |  Ok-000037      | Ok-000042
ID2 |  Ok-000043      | Ok-000045
ID2 |  Ok-000046      | Ok-000052

From the sample database records above, I would like to produce a report with the following format:

ID1 Ok-000001 - Ok-000018, Ok-000037 - Ok-000042
ID2 Ok-000043 - Ok-000052

In the actual database, there are 55,640 records with 1,559 unique IDs.

I'll take any and all guidance. I know that I need to group by ID. I know that I should ignore the "Ok-" and just work with the numeric values. I don't know how to look at the "Start of range" in the next record to see if it's a continuation of the "End of range" in the current record.

Sarnoff answered 18/9, 2016 at 10:49 Comment(3)
Which RDBMS you are using – Bender
I'm using Access (2010) – Sarnoff
As far as I know this is not going to be easy in Ms-Access. – Bender
C
2

This is just impossible to do in Ms-access SQL and you have to rely on VBA

I had 20 minutes to waste so I did it for you...

With the following table named TableSO 

ID  Start of range  End of range
ID1 Ok-000001       Ok-000009      
ID1 Ok-000010       Ok-000014      
ID1 Ok-000015                      
ID1 Ok-000016       Ok-000018      
ID1 Ok-000037       Ok-000042      
ID2 Ok-000043       Ok-000045      
ID2 Ok-000046       Ok-000052

The following sub generates the report you want

Public Sub TableSO_Treatment()

    Dim RST As Recordset
    Dim strReport As String
    Dim strStart As String
    Dim strEnd As String
    Dim lngStart As Long
    Dim lngEnd As Long
    Dim strCurrent As String
    Dim strPrev As String
    Dim strID As String
    Dim strPrevID As String
    Dim strPrevEnd As String
    Dim strLastStart As String

    Dim intPrev As Long

    Set RST = CurrentDb.OpenRecordset("SELECT ID, [Start of range] as start, [End of range] as end FROM TableSO ORDER BY [Start of range]")

    'init before loop
    strLastStart = Trim(RST!start)
    strPrevID = Trim(RST!ID)
    strCurrent = Trim(RST!ID) & " " & strLastStart


    ' Loop on all records
    While Not RST.EOF

        ' Init loop  value
        strID = RST!ID
        strStart = Trim(NZ(RST!start,""))
        strEnd = Trim(NZ(RST!end,""))

        ' if End Range empty give it the Start range value
        If strEnd = "" Then strEnd = strStart

        ' Make numbers out of the ranges
        lngStart = Val(Replace(strStart, "Ok-", ""))
        lngEnd = Val(Replace(strEnd, "Ok-", ""))


        ' Test if it's a new ID
        If strID <> strPrevID Then

            ' Its another ID !!!

            ' write new line
            strReport = strReport & strCurrent & " - " & strPrevEnd & vbCrLf

            'reinit curent line
            strCurrent = strID & " " & strStart
            strLastStart = strStart

        End If


        ' Test if we are in a streak of ranges
        If (lngprev + 1) = lngStart Then

            ' We are in a streak, do nothing

        Else

            ' The streak is broken, write current streak and init a new streak
            strCurrent = strCurrent & " - " & strPrevEnd & ", " & strStart

            'reinit the start range
            strLastStart = strStart

        End If

        ' Saving previous values for the next loop
        lngprev = lngEnd
        strPrevEnd = strEnd
        strPrevID = strID


        RST.MoveNext
    Wend

    ' Last write
    strReport = strReport & strCurrent & " - " & strEnd & vbCrLf

    ' Et voila :)
    Debug.Print strReport
End Sub

StrReport contains :

ID1 Ok-000001 - Ok-000018, Ok-000037 - Ok-000042
ID2 Ok-000043 - Ok-000052

Note that this works perfectly with the sample of data you provided. If you have shown all possibilities it will work with all of your table. But you might have forgot to specify some special cases and you'll have to adapt the procedure accordingly to match them. I have commented all the code properly so you can understand it and fix it by yourself if needed.

This is the only way to go. You will never achieve such a report with a Query and VBA is there for that

Edit

In this state the report will just be saved in memory and printed in the debug window. That's not optimal.

A first quick thing you can do is to :

  1. create a form
  2. add a very large textbox to it, name it TextReport.
  3. add a button, and add the procedure code in it's click event.
  4. at the end of the procedure, add an instruction TextReport.Value = strReport

Still it is not optimal if you have a very large table. Another possibility is to output the results into a text file :

  1. In the VBA window, under tools/references, check the library "Microsoft Scripting Runtime"

  2. Adapt the procedure like this and it will output the report to C:/AccessReport.txt

    Public Sub TableSO_Treatment()

    Dim RST As Recordset
Dim strReport As String
Dim strStart As String
Dim strEnd As String
Dim lngStart As Long
Dim lngEnd As Long
Dim strCurrent As String
Dim strPrev As String
Dim strID As String
Dim strPrevID As String
Dim strPrevEnd As String
Dim strLastStart As String
Dim intPrev As Long

' variables to output to a file :
Dim objFSO As New Scripting.FileSystemObject
Dim objFile As Scripting.TextStream
Const fsoForWriting = 2
Set objFile = objFSO.OpenTextFile("C:\AccessReport.txt", fsoForWriting, True)


Set RST = CurrentDb.OpenRecordset("SELECT ID, [Start of range] as start, [End of range] as end FROM TableSO ORDER BY [Start of range]")

'init before loop
strLastStart = Trim(RST!start)
strPrevID = Trim(RST!ID)
strCurrent = Trim(RST!ID) & " " & strLastStart


' Loop on all records
While Not RST.EOF

    ' Init loop  value
    strID = RST!ID
    strStart = Trim(Nz(RST!start, ""))
    strEnd = Trim(Nz(RST!End, ""))

    ' if End Range empty give it the Start range value
    If strEnd = "" Then strEnd = strStart

    ' Make numbers out of the ranges
    lngStart = Val(Replace(strStart, "Ok-", ""))
    lngEnd = Val(Replace(strEnd, "Ok-", ""))


    ' Test if it's a new ID
    If strID <> strPrevID Then

        ' Its another ID !!!

        ' write new line
        strReport = strReport & strCurrent & " - " & strPrevEnd & vbCrLf
        objFile.WriteLine strCurrent & " - " & strPrevEnd

        'reinit curent line
        strCurrent = strID & " " & strStart
        strLastStart = strStart

    End If


    ' Test if we are in a streak of ranges
    If (lngprev + 1) = lngStart Then

        ' We are in a streak, do nothing

    Else

        ' The streak is broken, write current streak and init a new streak
        strCurrent = strCurrent & " - " & strPrevEnd & ", " & strStart

        'reinit the start range
        strLastStart = strStart

    End If

    ' Saving previous values for the next loop
    lngprev = lngEnd
    strPrevEnd = strEnd
    strPrevID = strID


    RST.MoveNext
Wend

' Last write
strReport = strReport & strCurrent & " - " & strPrevEnd & vbCrLf
objFile.WriteLine strCurrent & " - " & strPrevEnd


' Et voila :)
Debug.Print strReport
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing

    End Sub

Certificate answered 18/9, 2016 at 12:16 Comment(8)
Seems like SO is a code writing service after all. :) But yeah, some questions are just intriguing enough. – Ceja
Thomas G, you're amazing. After I test it against my data, I'll comment here again. – Sarnoff
Needless to say, Thomas G, you're way, way ahead of me. – Sarnoff
Needless to say, Thomas G, you're way, way ahead of me. I understand your code, but I've never implemented a subroutine such as you've written. Here's how I implemented it...I created a blank report, went into Design View, clicked the code button, inserted your subroutine into the report's module, changed the name of the table in the OpenRecordset statement, saved, created an Open event that calls your subroutine. When I run the report, a run-time error '94' "Invalid use of Null" occurs on the statement "strEnd = Trim(RST!end)". Probably one of those special cases you warned me about. :-) – Sarnoff
@Sarnoff This happens because your empty [end range] contains a NULL value and not a blank string as I expected. You have to change that instruction to Trim(NZ(RST!end,"")) to change the nulls to a blank string. I adapt my procedure. – Certificate
I also added instructions to get the results in a better format ;) – Certificate
Final thanks to Thomas G. I tested both the "to file" version and the "to textbox" version. Because I have lots of records, I prefer the "to file" version. Your hard work is greatly appreciated!!!! – Sarnoff
@Sarnoff glad to have helped but don't forget your duties on stackoverflow: if I answered your question, mark the answer as accepted. And upvote if you found the answer good. ;) – Certificate

© 2022 - 2024 — McMap. All rights reserved.