Customising GetMrData.xls ( Split Data Across Sheets )

by

In a recent coment we where asked by Nathan to change the 

 so that when the get data section is run it spreads the data across multiple sheets. Having the data all on one sheet can be a problem in older versions of excel, as you are limited to a certain amount of columns. This article provides you with this updated 
 and explains how it is done.First off here is the 
,


Sub GetData()

'variables used to invoke the standard MS Data Link Properties dialog
Dim DataLinkHelper

'variables used to access ADO
Dim ADO
Dim SQLQuery
Dim RecordSet
Dim Field

'variables used to populate Excel cells
Dim XLSheet
Dim XLStartRow
Dim XLStartColumn
Dim XLCol
Dim XLRow
Dim iFieldsPerSheet
Dim oSheet



    'have the user specify the data source they wish to use
    Set DataLinkHelper = CreateObject("MROLEDB.DataLinkHelper")
    Result = DataLinkHelper.DisplayWizard() 'this will return the connection string
    If Result = "" Then 'User Canceled
        Call MsgBox("Data source selection canceled by user.")
        Exit Sub
    Else 'instantiate an ADO object and give it the connection string returned by the Data Link Properties dialog
        Set ADO = CreateObject("ADODB.Connection")
        ADO.ConnectionString = Result
        ADO.Open
    End If
    
    'execute a query that will return all the data
    'from the data source specfied by the user
    SQLQuery = "select * from vdata"
    Set RecordSet = ADO.Execute(SQLQuery)
    
    'now iterate thru the returned recordset to populate the Excel worksheet
    XLSheet = 1
    XLStartRow = 5
    XLStartColumn = 1
    For Each oSheet In Worksheets
        Worksheets(XLSheet).Cells.ClearContents
        XLSheet = XLSheet + 1
    Next
    
    XLCol = XLStartColumn
    XLRow = XLStartRow
    iFieldsPerSheet = 10
    XLSheet = 1
    
    For Each Field In RecordSet.Fields
        Worksheets(XLSheet).Cells(XLRow, XLCol).FormulaR1C1 = Field.Name
        XLCol = XLCol + 1
        If (iFieldsPerSheet < XLCol) Then
            XLCol = XLStartColumn
            XLSheet = XLSheet + 1
            If (Sheets.Count < XLSheet) Then
                Sheets.Add After:=Sheets(Sheets.Count)
            End If
        End If
    Next
     
    
    If Not RecordSet.EOF Then
        XLRow = XLStartRow + 1
        Do Until RecordSet.EOF
            XLCol = XLStartColumn
            XLSheet = 1
            For Each Field In RecordSet.Fields
                Worksheets(XLSheet).Cells(XLRow, XLCol).FormulaR1C1 = _
                         RecordSet(Field.Name)
                XLCol = XLCol + 1
                If (iFieldsPerSheet < XLCol) Then
                    XLCol = XLStartColumn
                    XLSheet = XLSheet + 1
                    If (Sheets.Count < XLSheet) Then
                        Sheets.Add After:=Sheets(Sheets.Count)
                    End If
                End If
            Next
            XLRow = XLRow + 1
            RecordSet.MoveNext
            DoEvents
        Loop
    End If
    ADO.Close
    
End Sub


you will see in the 


 above that we have added a variable "iFieldsPerSheet" set this variable to the number of columns required per sheet. You will see that this variable is used in a section of the script that looks like this,


                If (iFieldsPerSheet < XLCol) Then
                    XLCol = XLStartColumn
                    XLSheet = XLSheet + 1
                    If (Sheets.Count < XLSheet) Then
                        Sheets.Add After:=Sheets(Sheets.Count)
                    End If
                End If



so as we loop the data we count the number of columns and when our number of columns is greater than the number we have set previously we add a new sheet to the excel file, add one to XLSheet and then reset the column counter back to one and start the counting again. Next we have the update 


 that looks like this,

Sub UpdateData()

Dim ADO
Dim SQLQuery, FinalSQL, sqlUpdateQuery
Dim RecordSet, oUpdate, Field
Dim iCol, iRow, XLSheet, iFieldsPerSheet


    If Result = "" Then 'User Canceled
        Call MsgBox("You must run the Get Data First")
        Exit Sub
    Else
    
        'Check to see if we have a serial number column in A5
        If (Worksheets(1).Cells(5, 1).Text <> "Respondent.Serial") Then
            Call MsgBox("No 'Respondent.Serial' column found in A5")
            Exit Sub
        Else
            'instantiate an ADO object and give it the connection string returned by the Data Link Properties dialog
            Set ADO = CreateObject("ADODB.Connection")
            ADO.ConnectionString = Result
            ADO.Open
        End If
    End If
    
    SQLQuery = "select * from vdata"
    Set RecordSet = ADO.Execute(SQLQuery)
    
    iRow = Application.ActiveCell.Row
    iCol = 1
    XLSheet = 1
    iFieldsPerSheet = 10
    
    For Each Field In RecordSet.Fields

        If (iCol > 1) Then
           If (Worksheets(XLSheet).Cells(iRow, iCol) <> "") Then
            Select Case Field.Type
                Case Is = 3 ' Number
                  sqlUpdateQuery = "Update Vdata Set " & Field.Name & " = " & _
                           Worksheets(XLSheet).Cells(iRow, iCol) & " where _
                           respondent.serial = " & Worksheets(1).Cells(iRow, 1)
                Case Is = 202 ' decimal
                  sqlUpdateQuery = "Update Vdata Set " & Field.Name & " = '" & _
                           Worksheets(XLSheet).Cells(iRow, iCol) & "' where _
                            respondent.serial = " & Worksheets(1).Cells(iRow, 1)
                Case Is = 200 ' text
                  sqlUpdateQuery = "Update Vdata Set " & Field.Name & " = " & _
                            Worksheets(XLSheet).Cells(iRow, iCol) & " where _
                            respondent.serial = " & Worksheets(1).Cells(iRow, 1)
            End Select
            
            Set oUpdate = ADO.Execute(sqlUpdateQuery)
            
            End If
            
            If (iFieldsPerSheet < iCol) Then
                iCol = 1
                XLSheet = XLSheet + 1
            End If
        End If
        iCol = iCol + 1
    Next
        
    ADO.Close

End Sub



As we can see we have very similar 


,


            If (iFieldsPerSheet < iCol) Then
                iCol = 1
                XLSheet = XLSheet + 1
            End If




We keep a count of the columns , then when it is over the number we have set , we add one to the sheet count and reset the column count to 1, simple realy.

Leave a Comment

%d bloggers like this: