Dim sql As String

sql = "SELECT tblHeaders.ProNumber, SCAC_A AS SCAC, ShipDate_A AS ShipDate, upper(ShipperName_A) AS Shipper," & _
        " upper(ShipperAddress_A) AS [S Address], upper(ShipperCity_A) AS [S City], upper(ShipperState_A) AS [S ST]," & _
        " ShipperZip_A AS [S Zip], upper(ConsigneeName_A) AS Consignee, upper(ConsigneeAddress_A) AS [C Address], upper(ConsigneeCity_A) AS [C City]," & _
        " upper(ConsigneeState_A) AS [C ST], ConsigneeZip_A AS [C Zip], LineType_A as [Type], NMFC_A + '-' + NMFCSub_A AS NMFC," & _
        " NMFCClass_A AS CLASS, ItemWeight_A AS Weight, Charges_A AS Charges, Description_A As Description" & _
        " FROM tblHeaders JOIN tblLineItems ON tblHeaders.HeaderID = tblLineItems.HeaderID" & _
        " WHERE (Mode_A = 'l') AND (ClientID in (49320,9797,57885,39685)) AND (SubmissionDate BETWEEN '4/29/2008' AND '4/29/2008')" & _
        " and charges_A is not null AND LineType_A in ('I','D','FL')" & _
        " Order by ShipDate_A , ShipperName_A, ConsigneeName_A"

    Text1.Value = sql

    ExportSQLToExcel (sql)



End Sub

Sub ExportSQLToExcel(ByVal sSQL As String)

    Dim rs As ADODB.Recordset
    Dim xlApp As Excel.Application
    Dim iCol As Integer
    Set rs = New ADODB.Recordset
    Dim y As Integer
    Dim maxcell As Range
    Dim strPronumber As String



    StatusBar "Retrieving Data from Database..."
    DoCmd.Hourglass True
    rs.Open sSQL, CurrentProject.Connection, adOpenKeyset, adLockReadOnly

    If rs.RecordCount > 65535 Then
        MsgBox "More than 65535 records returned. First 65535 rows exported."
    End If

    If rs.RecordCount > 0 Then
        StatusBar "Exporting Data to Excel..."
        Set xlApp = CreateObject("Excel.Application")
        xlApp.Workbooks.Add
'Copies Column Names
        For iCol = 0 To rs.fields.Count - 1
            xlApp.Cells(1, iCol + 1) = rs.fields(iCol).Name
        Next
'Copies Data
        xlApp.Range("A2").CopyFromRecordset rs
        xlApp.Cells.Select
        xlApp.Cells.EntireColumn.AutoFit
'Changes Row 1 in Excel to a Dark Gray shade
        xlApp.Rows(1).Select
        xlApp.Selection.Interior.ColorIndex = 15       'Set background to Dark Gray
        xlApp.Selection.HorizontalAlignment = xlCenter

'NEED CODE TO GROUP COLUMN A CELLS THAT ARE THE SAME


'Reset Cursor to cell A1
        xlApp.Range("A1").Select
        xlApp.Visible = True
        xlApp.Sheets(1).Select
    Else
        MsgBox "No Records returned"
    End If
    ClearStatusBar
    DoCmd.Hourglass False

xlApp.ActiveSheet.UsedRange.Rows.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
      Replace:=True, PageBreaks:=False, SummaryBelowData:=True