visual basic

Posted on 2004-09-17
Last Modified: 2013-11-25
I had posted this question in the oracle forum; did not get answers. I think it is because it is difficult to accomplish this in plain sql. So I would like to know if this can be done using VB. Pl. paste code... to be precise.

I have created a query for data extraction ; I save it in the excel format and email it to user.


select distinct mkt.last ||', '|| mkt.first mktname, ||'-'|| phys.last ||', '|| phys.first physname,
     phys.zip1 ||', '|| phys.state zipst, phon.phonea ||'-'|| phoneb ||'-'|| phon.phonec physphone,
     invt.manufacturer_id ||'-'|| mfg,
     count(distinct ship.to_id) pats,   sum(shipi.quantity) qty

from shipments ship,
     patient_therapies pthx,
     patients_table pt,
     marketing mkt,
     shipment_items shipi,
     prescriptions_table presc,
     inventory invt,
     manufacturers man,
     physicians phys,
     phones phon

where ship.completed_date between '01-JAN-2004' AND '31-JAN-2004'
and ship.to_type = 'P'
and ship.to_id = pthx.patient_id
and ship.to_id =
and pt.marketing_id =
and pthx.stop_date is null
and pthx.therapy_type in (select therapy_type from therapy_types
                          where therapy_class in 'HARMONE')
and = shipi.shipment_id
and shipi.inventory_id =
and invt.tdrug_abbrev is not null
and invt.manufacturer_id =
and (shipi.rx_prescription_id = presc.prescription_id
    and shipi.rx_svcbr_id = presc.svcbr_id
    and shipi.rx_refill_no = presc.refill_no
    and ship.to_id = presc.patient_id)
and presc.physician_id =
and ( = phon.name_id(+)
    and phon.name_type = 'D'
    and phon.phone_seq = 1)
     and = 230323

group by mkt.last ||', '|| mkt.first, ||'-'|| phys.last ||', '|| phys.first,
     phys.zip1 ||', '|| phys.state, phon.phonea ||'-'|| phoneb ||'-'|| phon.phonec,
     invt.manufacturer_id ||'-'||

Sample data:

MKTNAME     PHYSNAME     MFG-id and name       PATS             QTY
SCOTT, LELA     323-MATHEW     25-ABC                   1                   7
SCOTT, LELA     323-MATHEW     34-EFH                  2                   17
SCOTT, LELA     323-MATHEW     67-XYZ                  1                   14

So one row is getting repeated thrice because there are 3 entries for mfg-id and name. But I want the following to be displayed in the foll. Format. The mfg id and its corresponding name may vary every time I run the sql.  i MEAN THE mfg id and name field can be abc, efg, xyz this week and next week it could be all of the above 3 and it could be some other ones like hjk, nmk,
Or it could not have any of the abc, efg, xyz and could be only hjk, nmkCan u please tell me how to get the data out in the foll. Format??.. THANKS EXPERTS!!!

MKTNAME     PHYSNAME     25-ABC     34-EFH     67-XYZ
SCOTT, LELA     323-MATHEW     7     17     14

I have some basic code in VB to read sql and dump results into csv file.

Option Explicit
Public strUserName As String
Public strPassWord As String
Public strBegDate As String
Public strEndDate As String
Private sFolderLoc As String
Private sSQL As String
Private conn As ADODB.Connection
Private rstRecordSet As ADODB.Recordset

Const SQL_Home = "C:\sql"
Public Sub Main()
Dim connStr As String
Dim sFileName As String
Dim sSQL As String

   On Error GoTo main_error
connStr = "PROVIDER=MSDASQL;" & _
            "DRIVER={microsoft odbc for oracle};" & _
            "SERVER=rxh_prod;" & _
            "UID=" & ";PWD=" & ";"

    Set conn = New ADODB.Connection

    conn.CursorLocation = adUseClient

    conn.Open connStr

    Screen.MousePointer = vbHourglass
    sFolderLoc = "C:\"   ' assign output location
    Set rstRecordSet = New ADODB.Recordset
   strBegDate = ConvertDate(Format(DateAdd("m", -8, Now), "mm/dd/yyyy"))
   strEndDate = ConvertDate(Format(DateAdd("d", -1, Now), "mm/dd/yyyy"))


    sSQL = " "
    sSQL = Build_Query(SQL_Home & "\sample.sql")
    rstRecordSet.Open sSQL, conn, adOpenForwardOnly

     sFileName = sFolderLoc & "\test.csv"
     WriteExcelReport1 sFileName
   ‘  rstRecordSet.Close

     Screen.MousePointer = vbDefault

    If Not rstRecordSet Is Nothing Then     'unload form and close recordset and connection to Oracle
       If rstRecordSet.State <> 0 Then
       End If
       Set rstRecordSet = Nothing
    End If

    If Not conn Is Nothing Then
       Set conn = Nothing
    End If
    MsgBox "Finished"
    Screen.MousePointer = vbNormal

    Screen.MousePointer = vbDefault
    MsgBox "Error- " & Err.Description & " - contact Report Solutions"
    If Not rstRecordSet Is Nothing Then     'unload form and close recordset and connection to Oracle
       If rstRecordSet.State <> 0 Then
       End If
       Set rstRecordSet = Nothing
    End If

    If Not conn Is Nothing Then
       Set conn = Nothing
    End If
    End Sub

Private Function Build_Query(sFileName As String)
    Dim sInput As String
    Dim sOutput As String
    Open sFileName For Input As #1

    Line Input #1, sInput   ' Get a line of input from the file(sFileName) and store it in the sInput
                            '  string
    sOutput = sInput
    Do While Not EOF(1)
        Line Input #1, sInput
        sOutput = sOutput & Chr(10) & sInput
    sOutput = Replace(sOutput, "&begdate", "'" & strBegDate & "'")
    sOutput = Replace(sOutput, "&enddate", "'" & strEndDate & "'")
    Close #1
    Build_Query = sOutput
End Function

Private Sub remove_file(fname As String)
    If Len(Dir(fname)) Then
        Kill fname
    End If
End Sub
Public Function ConvertDate(ByVal strDate As Date) As String
  'convert  date to Oracle date
  Dim strDateOut As String
  'Dim ConvertDate As String
  Select Case Val(Format(strDate, "mm"))
    Case 1
        strDateOut = Format(strDate, "dd") & "-JAN-" & Format(strDate, "YYYY") & ""
    Case 2
        strDateOut = Format(strDate, "dd") & "-FEB-" & Format(strDate, "YYYY") & ""
    Case 3
        strDateOut = Format(strDate, "dd") & "-MAR-" & Format(strDate, "YYYY") & ""
    Case 4
        strDateOut = Format(strDate, "dd") & "-APR-" & Format(strDate, "YYYY") & ""
    Case 5
        strDateOut = Format(strDate, "dd") & "-MAY-" & Format(strDate, "YYYY") & ""
    Case 6
        strDateOut = Format(strDate, "dd") & "-JUN-" & Format(strDate, "YYYY") & ""
    Case 7
        strDateOut = Format(strDate, "dd") & "-JUL-" & Format(strDate, "YYYY") & ""
    Case 8
        strDateOut = Format(strDate, "dd") & "-AUG-" & Format(strDate, "YYYY") & ""
    Case 9
        strDateOut = Format(strDate, "dd") & "-SEP-" & Format(strDate, "YYYY") & ""
    Case 10
        strDateOut = Format(strDate, "dd") & "-OCT-" & Format(strDate, "YYYY") & ""
    Case 11
        strDateOut = Format(strDate, "dd") & "-NOV-" & Format(strDate, "YYYY") & ""
    Case Else
        strDateOut = Format(strDate, "dd") & "-DEC-" & Format(strDate, "YYYY") & ""
  End Select

  ConvertDate = strDateOut
End Function

Private Sub WriteOutReport1(ByVal sFileName As String)
 'remove_file (sFileName)
     If rstRecordSet.RecordCount > 0 Then 'put data into file which will be read
     Open sFileName For Output As #1
        Write #1, rstRecordSet.Fields(0).Name, rstRecordSet.Fields(1).Name, _
                        rstRecordSet.Fields(2).Name, rstRecordSet.Fields(3).Name, _
                        rstRecordSet.Fields(4).Name, rstRecordSet.Fields(5).Name, _
                        rstRecordSet.Fields(6).Name, rstRecordSet.Fields(7).Name, _
                        rstRecordSet.Fields(8).Name, rstRecordSet.Fields(9).Name, _
                        rstRecordSet.Fields(10).Name, rstRecordSet.Fields(11).Name, _
                        rstRecordSet.Fields(12).Name, rstRecordSet.Fields(13).Name, _
                        rstRecordSet.Fields(14).Name, rstRecordSet.Fields(15).Name, _
                        rstRecordSet.Fields(16).Name, rstRecordSet.Fields(17).Name, _
                        rstRecordSet.Fields(18).Name, rstRecordSet.Fields(19).Name

        Do While Not rstRecordSet.EOF
                    Write #1, rstRecordSet.Fields(0), rstRecordSet.Fields(1), _
                        rstRecordSet.Fields(2), rstRecordSet.Fields(3), _
                        rstRecordSet.Fields(4), rstRecordSet.Fields(5), _
                        rstRecordSet.Fields(6), rstRecordSet.Fields(7), _
                        rstRecordSet.Fields(8), rstRecordSet.Fields(9), _
                        rstRecordSet.Fields(10), rstRecordSet.Fields(11), _
                        rstRecordSet.Fields(12), rstRecordSet.Fields(13), _
                        rstRecordSet.Fields(14), rstRecordSet.Fields(15), _
                        rstRecordSet.Fields(16), rstRecordSet.Fields(17), _
                        rstRecordSet.Fields(18), rstRecordSet.Fields(19)


        Close #1

    End If
End Sub

Private Sub WriteExcelReport1(ByVal sFileName As String)
   'remove_file (sFileName)
     'Create a new instance of Excel
   Dim oExcel As Object
   Dim oBook As Object
   Dim oSheet As Object
   Set oExcel = CreateObject("Excel.Application")
   'Open the text file
   Set oBook = oExcel.Workbooks.Open("C:\test.csv")

   'Save as Excel workbook and Quit Excel
   oBook.SaveAs sFolderLoc & "\EXCELREPORT_" & Format(Now, "mm""-""dd""-""yyyy") & ".xls", xlWorkbookNormal
    'remove_file (sFileName) 'this removes the csv file so that I only  see  the excel file
End Sub

This may be a good starting point I guess...
 Pl. paste ur code in my code. u can make changes to my code to suit ur code if would like...
Question by:Sara_j_11
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 7
  • 4
LVL 16

Expert Comment

ID: 12102065
Using your code above requires you to know which numbered fields contain which data, i.e. the quantity field is the same numbered field for each row (likewise the phys ID and mfg ID).  

With this concept in mind and your GROUP BY system keeping all records in order of name/phys id, you could read the current name into a string and loop around, checking if the name has changed.  If it has changed, update the current name string and start a new line.

Order your SQL results so that the MFG ID's for each name will always show in the same order so, if it exists, 11-abc will aways be first, followed by 12-def, etc.

Semi-code of an alternate WriteOutReport() sub follows:


Const namefieldno as Integer = 0
Const nphysidfieldno as Integer = 1
Const mfgidfieldno as Integer = 2
Const qtyfield as Integer = 3            'Substitute these for the actual field numbers
                                                     'Should be 0=first, 1=second,
                                                     '(otherwise trial and error?)

Dim CurrentName as String
Dim mfgarray() as String                 'I think but I'm not sure

'Enumerate all possible mfg id's, with a SELECT DISTINCT SQL statement
'and store them in a VB array

'Write fixed header rows
Print #1, rstRecordSet.Fields(namefieldno).Name & ",";
Print #1, rstRecordSet.Fields(physidfieldno).Name & ",";
Print #1, rstRecordSet.Fields(...).Name & ",";

'Write mfg ids into header row
Print #1, mfgarray(0) & ",";
Print #1, mfgarray(1) & ",";
Print #1, mfgarray(2) & ",";
Print #1, mfgarray(...) & ",";

'End header row
Print #1, ""           'No ';' begins a new line

Do while not rstRecordSet.EOF

    'Write fields with fixed info
    Print #1, rstRecordSet.Fields(namefieldno) & ",";
    Print #1, rstRecordSet.Fields(physidfieldno) & ",";
    Print #1, rstRecordSet.Fields(...) & ",";
    CurrentName = rstRecordSet.Fields(namefieldno)

    Do until rstRecordSet.Fields(namefieldno) <> CurrentName    'do the following until the name changes
        'Loop through the array of different MFG IDs:
            'Check if rstRecordSet.Fields(mfgidfieldno) = current array item
            'If so, Print #1, rstRecordSet.Fields(qtyfieldno) & ",";
            'If not, Print #1, ",";
        'Go to next MFG ID in array
        '(because the MFG IDs are always in the same order, you will not miss any)





I know its not the complete coded answer you were looking for but it should give you enough to think about.  I'm not in a position to test this myself at the moment, but I think the theory is sound.



LVL 16

Expert Comment

ID: 12102286
Alternatively, if you're already exporting to Excel, how about formatting as a PivotTable, using name or id as the rows, mfgid as the columns and qty as the data?

Author Comment

ID: 12164216
ok  how do I do it using pivot table... I just saved the result set using toad editor to excel and then used MKTNAME  as row and mfgid as column and then the count of pty and qty  as data so i am getting

MKTNAME      Data             1068-abc      1103-efg & CO.         5563- xyz
MAY, JOHN      Count of PATS      1        2                        1
                   Count of QTY      1        2                        1

But what about the other columns which just repeat such as PHYSNAME     Will they be rows or columns... I dont know how to bring them in.. Because if I bring them in I am not getting the correct format... Also could you tell me if it is possible to get this format using pivot table:

MANUFACTURERS:                        All MFGs:            1002-abc            1006-xyz INC            1009-sdk, INC      
AM      PHYSNAME      ZIPST      PHYSPHONE      PATS      QTY      PATS      QTY      PATS      QTY      PATS      QTY
BASS, DEBBIE      100613-COOK, DAVID      287, MD      xxx      1      4      0      0      0      0      0      0
WILLIAMS, TOM      10293-GORDON, MICHAEL      23, MA      yyy      5      140      0      0      0      0      0      0
HENRY, JOANNE      103307-ANGULO, MORIS      01, NY      hhh      4      11      0      0      0      0      0      0

This was pated from excel so if u copy this and paste the format to excel you may be able to see it clearer
PeopleSoft Has Never Been Easier

PeopleSoft Adoption Made Smooth & Simple!

On-The-Job Training Is made Intuitive & Easy With WalkMe's On-Screen Guidance Tool.  Claim Your Free WalkMe Account Now

LVL 16

Expert Comment

ID: 12164741
Select all data on your sheet, and choose PivotTable (its one of the menu options -- Tools, or Data menu).  Create your PivotTable as a new worksheet.
You'll now see a framework and a series of fields you can drag...

It sounds like you need to drag either the MarketName and/or the PhysName to the rows, the MFGID to the Columns and the PATS and QTY to the Data.

I'm not completely sure about the workings of a PivotTable, but I would expect that to show as per your original question.  As for the extra columns; due to the formatting on Experts Exchange, I can't see the desired format.  Could you send/post the sheet, with some sample data, so I can see what you need...

Author Comment

ID: 12169761
Is it possible to send a word document here? if yes , how...
LVL 16

Expert Comment

ID: 12171137
If you have a web/ftp site you can upload to, I can download it from there, otherwise my email is on my profile...

Author Comment

ID: 12184129
I have mailed you  the file
LVL 16

Expert Comment

ID: 12195671
I have received the file:  It looks like you could do this with an adaptation of the concepts I posted above.  I will try to write some code for you, soon.
LVL 16

Accepted Solution

jimbobmcgee earned 500 total points
ID: 12339183

Sorry it's taken me so long to get back to you; it's taken me a while to get the format just right!!

I believe I have solved the problem and offer the code below.  I took the sample data you gave me and pasted it into an Access table, to simulate your database environment.  

As such, you will have to change the constants to match your database, as well as the connection string and output filename, before it will function correctly but, if you follow the comments, you should be able to get a suitable output.

The SQL constants must correllate; the columns must be picked in order and grouped/ordered as described in the inline comments.

This routine is as scalable as I can make it with the data I have been given and should work with any database, as long as the constants are correct.

The purpose of this routine is to take flat file data and convert into a pivot-style text file.  

It requires that there be _one_ data column that should be transposed to appear as a number of columns.  This is refered to as the GROUP COLUMN in the comments.  Any columns before this Group Column are considered FIXED COLUMNS, whose data will appear on every row.  Any columns after the Group Column are considered RELATIVE COLUMNS; their data will be split and shown in a column relevant to the Group Column.

In addition to this, you can specify a number of GROUPED ROWS.  These are defined as the first few fixed columns, where data can be repetitive.  The concept behind Grouped Rows is that they are only shown when the data changes, creating 'cleaner' looking output files.  For the best effect, you should have at least 2 Grouped Rows.  These must also be ORDER BY'ed and GROUP BY'ed in the SQL constants, as required.

For the purpose of your data, I am writing these files as a tab-delimited file, as some of your data contains commas that will produce strange results when opened in Excel.

The code below should be pasted into a module within your project.  Any constants (Private Const...) should be amended to suit, the 'Conn.Open "..."' line should reflect your database and the 'Open "..." For Output As #1' line should contain your filename:

    Option Explicit
    Private Const sqlSelectAll      As String = "SELECT [MKTNAME], [PHYSNAME], " & _
                                                "[ZIPST], [PHYSPHONE], [MFG], " & _
                                                "[PATS], [QTY] " & _
                                                "FROM [tabINPUT] " & _
                                                "ORDER BY [MKTNAME], [PHYSNAME], [MFG]"
                                            'SQL FOR SELECTING ALL FIELDS IN CSV
                                            'MUST BE ORDERED FIRST BY GROUPED ROW
                                            'AND THEN GROUPED COLUMN FIELDS
    Private Const sqlRelSums        As String = "SELECT " & _
                                                "SUM([PATS]) AS [TOTALPATS], " & _
                                                "SUM([QTY]) AS [TOTALQTY]" & _
                                                "FROM [tabINPUT] " & _
                                                "GROUP BY [MKTNAME], [PHYSNAME] " & _
                                                "ORDER BY [MKTNAME], [PHYSNAME] "
                                            'SQL FOR THE SUM OF ALL GROUPED FIELDS
                                            'MUST BE ORDERED AND GROUPED BY ROW GROUP
                                            ' FIELDS
                                            'SUM FIELDS MUST BE SELECTED IN SAME ORDER
                                            ' AS THEIR COUNTERPARTS IN sqlSelectAll
    Private Const sqlGetGroups      As String = "SELECT DISTINCT [MFG] " & _
                                                "FROM [tabINPUT]" & _
                                                "ORDER BY [MFG]"
                                            'SQL TO FIND EACH INDIVIDUAL GROUP
                                            'CSV WILL WRITE GROUPS IN ORDER SPECIFIED
    Private Const strGroupCol       As String = "MFG"
                                            'MUST MATCH GROUPS COLUMN IN sqlGetGroups
                                            'WITHOUT [SQUARE BRACKET] NOTATION
    Private Const intRowGroups      As Integer = 2
                                            'NUMBER OF ROW GROUPS
                                            'SHOULD MATCH THE NUMBER OF 'GROUP BY'
                                            ' FIELDS IN sqlRelSums
    Private Const strDelim          As String = vbTab
                                            'DELIMETER IN SEPARATED VALUES FILE
    Private Const strZero           As String = " - "
                                            'TEXT TO USE WHEN COLUMN GROUP DATA IS NULL
    Private Const strEndOfRecord    As String = ""
                                            'TEXT THAT MARKS THE END OF A RECORD
    Private Conn                As New ADODB.Connection
    Private intFixCols          As Integer  'RECORDS BEFORE GROUP COLUMN
    Private intRelCols          As Integer  'RECORDS AFTER GROUP COLUMN
    Private intColGroups        As Integer  'NUMBER OF DISTINCT COLUMN GROUPS
    Private Sub WriteFlatSQLToPivotStyleCSV()
        '''INITIALISE GLOBAL VARIABLES TO ZERO'''''''''''''''''''''''''''''
        intFixCols = 0
        intRelCols = 0
        intColGroups = 0
        '''GET CONNECTION TO DATABASE''''''''''''''''''''''''''''''''''''''
        Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                  "Data Source=d:\input.mdb;"
        '''WRITE DATA FILE'''''''''''''''''''''''''''''''''''''''''''''''''
        Open "d:\output.txt" For Output As #1
            Call WriteHeaders
            Call WriteData
        Close #1
        '''CLOSE CONNECTION TO DATABASE''''''''''''''''''''''''''''''''''''
        Set Conn = Nothing
    End Sub
    Private Sub WriteHeaders()
        Dim RS              As New ADODB.Recordset
        Dim intLoop         As Integer      'STANDARD LOOP COUNTER
        Dim intLoop2        As Integer      'STANDARD LOOP COUNTER
        '''WRITE TOP LINE HEADERS (GROUPS AND TOTAL)'''''''''''''''''''''
        RS.Open sqlSelectAll, Conn
            For intLoop = 0 To RS.Fields.Count
                If RS.Fields(intLoop).Name = strGroupCol Then Exit For
                Print #1, strDelim;         'WRITE BLANK HEADERS TO FILE
            Next intLoop
            intFixCols = intLoop            'GET NUMBER OF FIXED COLUMNS
            intRelCols = RS.Fields.Count - (intLoop + 1)
                                            'GET NUMBER OF RELATIVE COLUMNS
        Print #1, "TOTAL";                  'WRITE TOTAL COLUMN
        For intLoop = 1 To intRelCols
            Print #1, strDelim;             'WRITE BLANK TOTAL COLUMN...
        Next intLoop                        '...FOR EACH RELATIVE COLUMN
        RS.Open sqlGetGroups, Conn          'GET EACH GROUP FOR COLUMN HEADERS
            Do Until RS.EOF
                Print #1, UCase(RS.Fields(strGroupCol).Value);
                                            'WRITE GROUP TO FILE AS HEADER
                For intLoop = 1 To intRelCols
                    Print #1, strDelim;     'WRITE BLANK GROUP COLUMN HEADERS...
                Next intLoop                '...FOR EACH RELATIVE COLUMN
                intColGroups = intColGroups + 1
                                            'MAINTAIN COUNTER OF GROUP COLUMNS
        Print #1, ""
        '''WRITE FIXED/RELATIVE COLUMN HEADERS''''''''''''''''''''''''''''''
        RS.Open sqlSelectAll, Conn
            For intLoop = 1 To intFixCols
                Print #1, RS.Fields(intLoop - 1).Name & strDelim;
            Next intLoop
            For intLoop = 1 To intColGroups + 1 'HEADERS FOR RELATIVES AND TOTAL
                For intLoop2 = 1 To intRelCols
                    Print #1, RS.Fields(intFixCols + intLoop2).Name;
                    If intLoop = intColGroups + 1 And intLoop2 = intRelCols Then
                        Print #1, ""            'WRITE ROW SEPARATOR
                        Print #1, strDelim;          'WRITE COLUMN SEPARATOR
                    End If
                Next intLoop2
            Next intLoop
    End Sub
    Private Sub WriteData()
        Dim RS                                  As New ADODB.Recordset
        Dim RSTotals                            As New ADODB.Recordset
        Dim RSGroups                            As New ADODB.Recordset
        Dim intLoop                             As Integer
        Dim intLoop2                            As Integer
        Dim blnDoneTotals                       As Boolean
        Dim blnWriteRowGroupsFromHere           As Boolean
        Dim blnFirstGroup                       As Boolean
        ReDim strPrevRec(0 To intRowGroups - 1) As String
                                            'FOR EACH ROW GROUPED, STORE A
                                            'PREVIOUS VALUE
        RS.Open sqlSelectAll, Conn          'GET ALL DATA
        RSTotals.Open sqlRelSums, Conn      'GET ALL RELATIVE COLUMN TOTALS
        RSGroups.Open sqlGetGroups, Conn    'GET ALL RELATIVE COLUMN HEADERS
        blnWriteRowGroupsFromHere = True    'SET HEADER WRITER TO WRITE 1st TIME
        For intLoop = 0 To intRowGroups - 1
            strPrevRec(intLoop) = ""        'RESET PREVIOUS VALUES TO NULL
        Next intLoop
        RS.MoveFirst                        'MOVE TO START OF ALL DATA
        RSTotals.MoveFirst                  'MIRROR MOVEMENT OF TOTALS DATA
        Do Until RS.EOF
            '''WRITE ROW GROUP HEADERS AS REQUIRED''''''''''''''''''''''''''''''
            For intLoop = 0 To intRowGroups - 1
                If RS.Fields(intLoop).Value <> strPrevRec(intLoop) Or _
                    blnWriteRowGroupsFromHere = True Then
                                            'CHECK IF ROW HEADERS ARE DIFFERENT
                                            'FROM THE LAST TIME ROUND
                    Print #1, RS.Fields(intLoop).Value & strDelim;
                    blnWriteRowGroupsFromHere = True
                                            'WRITE ROW HEADERS ONLY IF THEY HAVE
                                            'CHANGED, FROM WHERE THEY CHANGE
                    Print #1, strDelim;     'IF ROW HEADER NOT CHANGED INSERT
                                            'BLANK FIELD
                End If
                strPrevRec(intLoop) = RS.Fields(intLoop).Value
                                            'STORE THE PREVIOUS RECORDS FOR THE
                                            'SAME CHECK NEXT TIME
            Next intLoop
            blnWriteRowGroupsFromHere = False
                                            'RESET THE ROW HEADER WRITER
            '''WRITE REMAINING FIXED ROW DATA'''''''''''''''''''''''''''''''''''
            For intLoop = intRowGroups To (intFixCols - 1)
                Print #1, RS.Fields(intLoop).Value & strDelim;
                                            'WRITE DATA BETWEEN ROW GROUPS AND
                                            'COLUMN GROUPS
            Next intLoop
            '''WRITE REPEATING COLUMN TOTALS''''''''''''''''''''''''''''''''''''
            For intLoop = 0 To intRelCols - 1
                Print #1, RSTotals(intLoop).Value & strDelim;
            Next intLoop
            '''WRITE REPEATING COLUMN GROUP DATA''''''''''''''''''''''''''''''''
            Do Until RS.Fields(strGroupCol).Value = RSGroups(0).Value
                For intLoop = 1 To intRelCols
                    Print #1, strZero & strDelim;
                Next intLoop
                RSGroups.MoveNext           'WRITE BLANK COLUMNS UNTIL THE FIRST
                                            'COLUMN DATA VALUE OCCURS
            Do Until RSGroups.EOF
                For intLoop = intFixCols + 1 To intFixCols + intRelCols
                                            'LOOP THROUGH THE RELATIVE COLUMNS...
                    If RS.Fields(strGroupCol).Value = RSGroups(0).Value Then
                        Print #1, RS.Fields(intLoop).Value & strDelim;
                                            'WRITE COLUMN DATA VALUES IF THE GROUP
                                            'COLUMN OF THE 'ALL DATA' RECORDSET
                                            'MATCHES THE GROUP WE ARE CHECKING
                        Print #1, strZero & strDelim;
                                            'OTHERWISE, WRITE A BLANK COLUMN
                    End If
                Next intLoop
                If RS.Fields(strGroupCol).Value = RSGroups(0).Value Then RS.MoveNext
                                            'MOVE TO THE NEXT 'ALL DATA' RECORD,
                                            'ONLY IF A GROUP IS MATCHED
                RSGroups.MoveNext           'CHECK THE NEXT GROUP
                If RS.EOF Then Exit Do      'IF THE 'ALL DATA' RECORDSET IS FINISHED
                                            'STOP READING FROM IT
                For intLoop = 0 To intRowGroups - 1
                    If RS.Fields(intLoop).Value <> strPrevRec(intLoop) Then Exit Do
                    strPrevRec(intLoop) = RS.Fields(intLoop).Value
                                            'IF ANY OF THE ROW GROUP HEADERS HAVE
                                            'CHANGED, STOP READING THE GROUP COLUMNS
                Next intLoop
            Do Until RSGroups.EOF
                For intLoop = 1 To intRelCols
                    Print #1, strZero & strDelim;
                Next intLoop                'IF THE ROW GROUP HEADERS CHANGE BEFORE
                                            'THE END OF THE 'GROUPS DATA' RECORDSET,
                RSGroups.MoveNext           'WRITE THE REMAINING BLANK COLUMNS
            Print #1, strEndOfRecord        'WRITE THE END OF LINE/RECORD MARKER
    End Sub

I sincerely hope this helps you with your task.  I will e-mail the files I have created, for your reference.



Author Comment

ID: 12463705
I will try to test this and award points..
LVL 16

Expert Comment

ID: 12752758
Sara_J_11  -- do you still need help with this?


Featured Post

[Webinar] Code, Load, and Grow

Managing multiple websites, servers, applications, and security on a daily basis? Join us for a webinar on May 25th to learn how to simplify administration and management of virtual hosts for IT admins, create a secure environment, and deploy code more effectively and frequently.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A theme is a collection of property settings that allow you to define the look of pages and controls, and then apply the look consistently across pages in an application. Themes can be made up of a set of elements: skins, style sheets, images, and o…
Whether you've completed a degree in computer sciences or you're a self-taught programmer, writing your first lines of code in the real world is always a challenge. Here are some of the most common pitfalls for new programmers.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

740 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question