Sub GetData()
'On Error GoTo handleerrors
Dim adFZFUELRs As ADODB.Recordset
Dim intFldCount As Integer
Dim intICol As Integer
Dim strSQL As String
Dim intRow As Integer
Dim MyRange As Range
Dim strStartDate As Date
Dim strEndDate As Date
Dim strSQLDate As String
Dim strSubtot1 As String
strSQLDate = "substr(digits(fzdate),1,2)||'/'||substr(digits(fzdate),3,2)||'/'||substr(digits(fzdate),5,2)"
Rows.Delete
strStartDate = InputBox("Enter the Start Date", "Start Date")
strEndDate = InputBox("Enter the End Date", "End Date")
Set adAS400Conn = New ADODB.Connection
adAS400Conn.Open "Provider=IBMDA400.DataSource.1;Password=RAVENS11;Persist Security Info=False;User ID=ITADMIN;Data Source=192.168.1.5"
strSQL = "SELECT FZUNIT as UNIT#, FZSTAT as ST, FZDV# as DIV, " & _
strSQLDate & " as DATE, FZCK# as INVOICE#, FZAGNT as TRUCK, " & _
"FZVNDR as STOP, FZCITY as CITY, FZQTY1 as GALLONS, FZAMT1 as TOTAL_COST " & _
"FROM IESFILE.FZFUEL " & _
"WHERE " & strSQLDate & " Between '" & strStartDate & "' And '" & strEndDate & "'"
Set adFZFUELRs = New ADODB.Recordset
adFZFUELRs.Open strSQL, adAS400Conn, adOpenKeyset
' Copy field names to the first row of the worksheet
intFldCount = adFZFUELRs.Fields.Count
For intICol = 1 To intFldCount
Cells(1, intICol).Value = adFZFUELRs.Fields(intICol - 1).Name
Next
'copy the data into the workbook
intFldCount = adFZFUELRs.RecordCount
Cells(2, 1).CopyFromRecordset adFZFUELRs
'do formula for cost per gallon
Cells(1, 11).Value = "COST PER GALLON"
Cells(1, 12).Value = "COST PER STOP"
intRow = Rows.Row + 1
intFldCount = adFZFUELRs.RecordCount
[b]Set MyRange = Range("K2:K" & intFldCount)[/b]
MyRange.Formula = "=J" & intRow & "/I" & intRow
'sort the data by location
Cells.Select
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Key2:=Range("H1"), Order2:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'get the subtotals
Cells.Select
Selection.Subtotal groupby:=3, Function:=xlCount, totallist:=10
intFldCount = adFZFUELRs.RecordCount
intRow = Rows.Row + 1
Do Until intRow = adFZFUELRs.RecordCount
If Len(Cells(intRow, 1).Value) = 0 Then
Cells(intRow, 7).Value = Cells(intRow, 10).Value
strSubtot1 = "=Sum(" & Mid(Cells(intRow, 10).Formula, 13)
Cells(intRow, 10).Formula = strSubtot1
Cells(intRow, 10).Select
Selection.Copy
Range("I" & intRow).Select
ActiveSheet.Paste
Cells(intRow, 12).Formula = "=(" & Cells(intRow, 10).Value & ")/(" & Cells(intRow, 7).Value & ")"
Cells(intRow, 10).Font.Bold = True
Cells(intRow, 8).Font.Bold = True
Cells(intRow, 12).Font.Bold = True
Cells(intRow, 3).Value = Cells(intRow, 3).Value & " / Total Cost / Cost Per Stop"
End If
intRow = intRow + 1
Loop
'format the worksheet
Columns.AutoFit
Rows.AutoFit
Range("D:D").NumberFormat = "mm/dd/yyyy"
Range("K:K").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
Range("J:J").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
Range("L:L").NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
Range("I:I").NumberFormat = "#,##0.00_);[Red](#,##0.00)"
Cells(2, 1).Select
ActiveWindow.FreezePanes = True
Range("A1:L1").Font.Bold = True
Cells(1, 1).Select
adFZFUELRs.Close
Set adFZFUELRs = Nothing
CloseConn
err_exit:
Exit Sub
handleerrors:
MsgBox "Either you canceled the process, or there has been an error."
Resume err_exit
End Sub