Extracting Access Data to Excel - SQL/ADO

[Lee.]

Hi,
I have wrote a macro which extracts data from an Access database and into Excel in order to summarise the data. However, I do I amend the format which it retrieves the data?

The data is currently produced in the following format
[TABLE="width: 500"]
<tbody>[TR]
[TD]Team Name[/TD]
[TD]Refund Category[/TD]
[TD]Total Refunded[/TD]
[/TR]
[TR]
[TD]Team 1[/TD]
[TD]Incorrect Fee[/TD]
[TD]£600[/TD]
[/TR]
[TR]
[TD]Team 1[/TD]
[TD]Gesture of Goodwill[/TD]
[TD]£500[/TD]
[/TR]
[TR]
[TD]Team 1[/TD]
[TD]Complaint[/TD]
[TD]£500[/TD]
[/TR]
[TR]
[TD]Team 1[/TD]
[TD]Staff Error[/TD]
[TD]£50[/TD]
[/TR]
[TR]
[TD]Team 2[/TD]
[TD]Staff Error[/TD]
[TD]£200[/TD]
[/TR]
[TR]
[TD]Team 2[/TD]
[TD]Complaint[/TD]
[TD]£50[/TD]
[/TR]
[TR]
[TD]Team 2[/TD]
[TD]Incorrect Fee[/TD]
[TD]£50[/TD]
[/TR]
[TR]
[TD]Team 3[/TD]
[TD]Incorrect Fee[/TD]
[TD]£1000[/TD]
[/TR]
[TR]
[TD]Team 4[/TD]
[TD]Gesture of Goodwill[/TD]
[TD]£150[/TD]
[/TR]
</tbody>[/TABLE]

However I would like the format to be
[TABLE="width: 500"]
<tbody>[TR]
[TD]Team Name[/TD]
[TD]Incorrect Fee[/TD]
[TD]Gesture of Goodwill[/TD]
[TD]Complaint[/TD]
[TD]Staff Error[/TD]
[/TR]
[TR]
[TD]Team 1[/TD]
[TD]£600[/TD]
[TD]£500[/TD]
[TD]£500[/TD]
[TD]£50[/TD]
[/TR]
[TR]
[TD]Team 2[/TD]
[TD]£50[/TD]
[TD][/TD]
[TD]£50[/TD]
[TD]£200[/TD]
[/TR]
[TR]
[TD]Team 3[/TD]
[TD]£1000[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Team 4[/TD]
[TD][/TD]
[TD]£150[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

The code I currently have is

Sub Refund_MI_By_Category_Team()
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim fld As ADODB.Field
    Dim MyConn
    Dim i As Long
    Dim ShDest As Worksheet
    Dim sSQL As String
    Dim zMonth, zteam As String
    Dim Rw As String
    Rw = Range("A6000").End(xlUp).Row + 2
    Rw = "A" & Rw
    zMonth = MI_Search.ComboBox1.Value
    Set ShDest = Sheets("Dashboard_MI")


    
    sSQL = "SELECT TEAM_NAME as [Team Name], REFUND_CATEGORY as [Refund Category], SUM(REFUND_AMOUNT) as [Total Refunded] FROM REFUND_DATA WHERE MONTH_YEAR = '" & zMonth & "' GROUP BY TEAM_NAME,REFUND_CATEGORY"
    Set cnn = New ADODB.Connection
    MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
    
    With cnn
        .Provider = "Microsoft.Jet.OLEDB.4.0"
        .Properties("Jet OLEDB:Database Password") = "**********"
        .Open MyConn
    End With


    Set rst = New ADODB.Recordset
    rst.CursorLocation = adUseServer
    rst.Open Source:=sSQL, ActiveConnection:=cnn, _
             CursorType:=adOpenForwardOnly, LockType:=adLockOptimistic, _
             Options:=adCmdText
    
    ShDest.Activate
     
    i = 0
    With Range(Rw)
        For Each fld In rst.Fields
            .Offset(0, i).Value = fld.Name
            i = i + 1
        Next fld
    End With
    Rw = Range("A6000").End(xlUp).Row + 1
    Rw = "A" & Rw


    Range(Rw).CopyFromRecordset rst


    rst.Close
    cnn.Close
    Set rst = Nothing
    Set cnn = Nothing
End Sub

Thanks

 

[RickXL]

Hi,

The simple way would be to use a PivotTable.

Set the Teams as Rows, the Categories as Columns and the Amounts as Values.

You can create PivotTables manually, or you can do it using macros (you can record a manual creation as well).

You can also use VBA to interrogate the PivotTable for further processing if required.