Sub a()
Dim oConn As Object
Dim oRS As Object
Dim sFilename As String
Dim sConnect As String
Dim sSQL As String
Dim i As Long, j As Long
Const adOpenForwardOnly As Long = 0
Const adLockReadOnly As Long = 1
Const adCmdText As Long = 1
sFilename = "c:\Mytest\Volker1.xls"
sConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & sFilename & ";" & _
"Extended Properties=Excel 8.0;"
Set oRS = CreateObject("ADODB.Recordset")
sSQL = "SELECT Last_Name, " & vbNewLine & _
" First_Name, " & vbNewLine & _
" Budget_Code, " & vbNewLine & _
" SUM(Amount), " & vbNewLine & _
" SUM(Quantity1) AS 'Quantity1', " & vbNewLine & _
" SUM(Quantity2) AS 'Quantity2', " & vbNewLine & _
" SUM(Quantity3) AS 'Quantity3' " & vbNewLine & _
"FROM [Sales$] " & vbNewLine & _
"WHERE Budget_Code = 1110 " & vbNewLine & _
"GROUP BY Last_Name, First_Name, Budget_Code"
oRS.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data.
If Not oRS.EOF Then
For i = 1 To oRS.fields.Count
Cells(1, i).Value = oRS.fields.Item(i - 1).Name
Next i
Range("A2").CopyFromRecordset oRS
For j = 2 To Cells(Rows.Count, "A").End(xlUp).Row
Cells(j, i).FormulaR1C1 = "=SUM(RC[-3]:RC[-1])*0.5"
Next j
Else
MsgBox "No records returned.", vbCritical
End If
' Clean up our Recordset object.
oRS.Close
Set oRS = Nothing
End Sub