Solved

visual basic

Posted on 2004-09-17
13
269 Views
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.

Sql:

select distinct mkt.last ||', '|| mkt.first mktname,
     phys.id ||'-'|| phys.last ||', '|| phys.first physname,
     phys.zip1 ||', '|| phys.state zipst, phon.phonea ||'-'|| phoneb ||'-'|| phon.phonec physphone,
     invt.manufacturer_id ||'-'|| man.name 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 = pt.id
and pt.marketing_id = mkt.id
and pthx.stop_date is null
and pthx.therapy_type in (select therapy_type from therapy_types
                          where therapy_class in 'HARMONE')
and ship.id = shipi.shipment_id
and shipi.inventory_id = invt.id
and invt.tdrug_abbrev is not null
and invt.manufacturer_id = man.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 = phys.id
and (phys.id = phon.name_id(+)
    and phon.name_type = 'D'
    and phon.phone_seq = 1)
     and phys.id = 230323

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


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
   
    DoEvents

    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"
     
rstRecordSet.Close
   
     
     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
              rstRecordSet.Close
       End If
       Set rstRecordSet = Nothing
    End If

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

    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
              rstRecordSet.Close
       End If
       Set rstRecordSet = Nothing
    End If

    If Not conn Is Nothing Then
       conn.Close
       Set conn = Nothing
    End If
   
    End
   
    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
    Loop
   
    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)
                       

        rstRecordSet.MoveNext
        Loop

        Close #1

      'rstRecordSet.Close
    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
   oExcel.Quit
   
    '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...
Thanks!!
0
Comment
Question by:Sara_j_11
  • 7
  • 4
13 Comments
 
LVL 16

Expert Comment

by:jimbobmcgee
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



'WRITE OWN CODE TO:
'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
       
        'WRITE OWN CODE TO:
        '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)

        rstRecordSet.MoveNext

    Loop

Loop

-----------------------

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.

HTH

Regards,

Jamie
0
 
LVL 16

Expert Comment

by:jimbobmcgee
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?
0
 

Author Comment

by:Sara_j_11
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

            MFG            
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
0
 
LVL 16

Expert Comment

by:jimbobmcgee
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...
0
 

Author Comment

by:Sara_j_11
ID: 12169761
Is it possible to send a word document here? if yes , how...
0
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 16

Expert Comment

by:jimbobmcgee
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...
0
 

Author Comment

by:Sara_j_11
ID: 12184129
I have mailed you  the file
0
 
LVL 16

Expert Comment

by:jimbobmcgee
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.
0
 
LVL 16

Accepted Solution

by:
jimbobmcgee earned 500 total points
ID: 12339183
Hi.  

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''''''''''''''''''''''''''''''''''''
        Conn.Close
        Set Conn = Nothing
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
       
    End Sub
   
   
    Private Sub WriteHeaders()
   
        'THIS FUNCTION ASSUMES THAT EVERYTHING AFTER GROUP COLUMN SHOULD BE
        'SHOWN RELATIVE TO (UNDER) A GROUP
   
        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
                                           
        RS.Close
       
        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
       
            RS.MoveFirst
            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
                RS.MoveNext
               
            Loop
           
        RS.Close
       
        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
                    Else
                        Print #1, strDelim;          'WRITE COLUMN SEPARATOR
                    End If
   
                Next intLoop2
            Next intLoop
       
        RS.Close
        '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
   
    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
       
        '''GET DATA IN SEPARATE RECORDSETS USING sql... STRING CONSTANTS''''''''
        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
                Else
               
                    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
            RSTotals.MoveNext
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
           
            '''WRITE REPEATING COLUMN GROUP DATA''''''''''''''''''''''''''''''''
            RSGroups.MoveFirst
           
            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
            Loop
           
           
            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
                    Else
                        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
               
            Loop
           
            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
           
            Loop
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
           
            Print #1, strEndOfRecord        'WRITE THE END OF LINE/RECORD MARKER
           
        Loop
       
    End Sub


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

Regards,

J.
0
 

Author Comment

by:Sara_j_11
ID: 12463705
I will try to test this and award points..
Thanks!
0
 
LVL 16

Expert Comment

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

J.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
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…
This is Part 3 in a 3-part series on Experts Exchange to discuss error handling in VBA code written for Excel. Part 1 of this series discussed basic error handling code using VBA. http://www.experts-exchange.com/videos/1478/Excel-Error-Handlin…

758 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

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now