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

Team Name	Refund Category	Total Refunded
Team 1	Incorrect Fee	£600
Team 1	Gesture of Goodwill	£500
Team 1	Complaint	£500
Team 1	Staff Error	£50
Team 2	Staff Error	£200
Team 2	Complaint	£50
Team 2	Incorrect Fee	£50
Team 3	Incorrect Fee	£1000
Team 4	Gesture of Goodwill	£150

<tbody>
</tbody>

However I would like the format to be

Team Name	Incorrect Fee	Gesture of Goodwill	Complaint	Staff Error
Team 1	£600	£500	£500	£50
Team 2	£50		£50	£200
Team 3	£1000
Team 4		£150

<tbody>
</tbody>

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.