Several people have asked how loops can be used in Access and Excel.
The following is code inside the click event of an access button.
It dynamically creates SQL code for a recordset, creates a blank Excel workbook, line 103 to 110 creates a hard coded title. At the next row, we harvest data from the database record set and places each row into the Excel worksheet. Some simple math is performed each row a field at a time.
In this case a Buy vs Sell just determineis if the data is multiplied by negative one.
After the data is created in Excel,
Code:Private Sub cmdActSumFlat_Click() Dim objXL As Object Dim objActiveWkb As Object Dim intRow As Integer Dim rsDeals As DAO.Recordset Dim strSQL As String Dim intSheet1MaxRowCount As Integer Dim intSheet2MaxRowCount As Integer Dim X1 As Integer ' if "Buy then multiply times -1 10 On Error GoTo PROC_ERROR 20 DoCmd.Hourglass True 30 Set objXL = CreateObject("Excel.Application") 'objXL.Visible = True ' just uncomment during testing 40 objXL.Application.Workbooks.Add 50 With objXL 60 .Worksheets(1).Cells(1, 1).ColumnWidth = 10 70 .Worksheets(1).Cells(1, 2).ColumnWidth = 30 ' you can add more 80 .Worksheets(1).Columns("C:C").Select 90 .Selection.NumberFormat = "_(* #,##0_);_(* (#,##0);_(* ""-""??_);_(@_)" 100 .Sheets(1).Name = "DealDetails" 101 intRow = 1 102 .Worksheets(1).Cells(intRow, 1) = "BuySell" ' column holds "buy" or "sell" 103 .Worksheets(1).Cells(intRow, 2) = "CompanyName" 104 .Worksheets(1).Cells(intRow, 3) = "DealFactoryVol" 105 .Worksheets(1).Cells(intRow, 4) = "DealFactoryCost" 106 .Worksheets(1).Cells(intRow, 5) = "NormalVol" 107 .Worksheets(1).Cells(intRow, 6) = "ActualVol" 108 .Worksheets(1).Cells(intRow, 7) = "CostNormal" 109 .Worksheets(1).Cells(intRow, 8) = "CostActual" 110 strSQL = qryActSummaryRptBase ' a subroutine to create sql string 120 Set rsDeals = CurrentDb.OpenRecordset(strSQL, dbOpenSnapshot, dbSeeChanges) 130 intRow = 2 131 X1 = 1 ' if buysell = sell then multiply data value time -1 140 Do Until rsDeals.EOF 141 If rsDeals!BuySell = "Buy" Then X1 = -1 ' as data is retrieved row by row - we can perform math such as multiply by -1 150 .Worksheets(1).Cells(intRow, 1) = rsDeals!BuySell 151 .Worksheets(1).Cells(intRow, 2) = rsDeals!CompanyName 152 .Worksheets(1).Cells(intRow, 3) = rsDeals!DealNomVol * X1 153 .Worksheets(1).Cells(intRow, 4) = rsDeals!DealNomCost * X1 154 .Worksheets(1).Cells(intRow, 5) = rsDeals!NomVol * X1 155 .Worksheets(1).Cells(intRow, 6) = rsDeals!ActVol * X1 156 .Worksheets(1).Cells(intRow, 7) = rsDeals!CostNom * X1 157 .Worksheets(1).Cells(intRow, 8) = rsDeals!CostAct * X1 170 rsDeals.MoveNext ' just read the next row 180 intRow = intRow + 1 ' increment counter - used for Excel Row 185 intSheet1MaxRowCount = intRow ' keep track of the maximum row 189 X1 = 1 ' just reset this variable back to 1 before reading next row 190 Loop ' go read the next row ' After the loop is completed - lets format the excel worksheet 600 .Sheets(1).Select ' Sheet 1 of several 610 .Cells.Select ' select all the cells 620 .Cells.EntireColumn.AutoFit ' fits columns to data in them 630 .Worksheets(1).Range("A1").Select 640 .Worksheets(1).Range("A1:H1").Select ' a header row to bold 650 .Selection.Font.Bold = True 660 .ActiveWindow.SplitRow = 1 ' add split row autofilter - then insert totals above afterwards 670 .ActiveWindow.FreezePanes = True 680 .Rows("1:1").Select 690 .Selection.Insert Shift:=xlDown 700 .Worksheets(1).Cells(1, 3).Select 710 .ActiveCell.FormulaR1C1 = "=SUBTOTAL(109,R[2]C:R[49999]C)" ' total all that are visable, user can hide a row later and see the new total DoEvents ' in case user has old busy PC, lets Windows catch up 711 .Worksheets(1).Cells(1, 3).Select 712 DoEvents ' in case user has old busy PC, lets Windows catch up 713 .Worksheets(1).Range("C1").AutoFill Destination:=Range(Cells(1, 3), Cells(1, 8)) ' suggested on web 715 '.Selection.AutoFill Destination:=Range("C1:H1") ' , Type:=xlFillDefault fails in runtime only 720 .Worksheets(1).Cells(1, 2).Select 730 .ActiveCell.FormulaR1C1 = "SubTotals for Rows not hidden (hide a row to update)" 740 .Worksheets(1).Cells(3, 1).Select ' A2 750 .Selection.AutoFilter 751 .Rows("1:1").Select 752 .Selection.Insert Shift:=xlDown 753 .Selection.Insert Shift:=xlDown 754 .Rows("4:4").Select 755 .Selection.Cut 766 .Rows("1:1").Select 767 .ActiveSheet.Paste 768 .Rows("4:4").Select 769 .Selection.Delete Shift:=xlUp 770 .ActiveCell.FormulaR1C1 = "=R[1]C" 771 .Range("D3").Select 772 .Selection.Style = "Currency" 773 .Range("G3").Select 774 .Selection.Style = "Currency" 775 .Range("H3").Select 776 .Selection.Style = "Currency" 777 .Range("D2").Select 778 .ActiveCell.FormulaR1C1 = "=R[1]C" 779 .Range("G2").Select 780 .ActiveCell.FormulaR1C1 = "=R[1]C" 781 .Range("H2").Select 782 .ActiveCell.FormulaR1C1 = "=R[1]C" 783 .Range("E2").Select 784 .ActiveCell.FormulaR1C1 = "=R[1]C" 785 .Range("F2").Select 786 .ActiveCell.FormulaR1C1 = "=R[1]C" 787 .Rows("2:2").Select 788 .Selection.Font.Bold = True 789 .Range("C2").Select 790 .ActiveCell.FormulaR1C1 = "=R[1]C" 810 End With 815 820 DoCmd.Close acForm, Me.Name ' opened from Access report 830 Reports(strReportName).blnCancelSummaryReport = True 'opened from report - report passed in as string arugment PROC_EXIT: 1440 On Error Resume Next 1450 DoCmd.Hourglass False 1460 objXL.Visible = True 1465 Set objXL = Nothing 1470 Exit Sub PROC_ERROR: ' a homemade centralized error table, keeps track 1480 Select Case Err.Number 'Case ### Case Else 1490 fLogError Err.Number, Erl, Err.Description, "Form_frmRPTActivitySummary", "cmdActivitysumflat_Click", True 1500 Resume PROC_EXIT 1510 End Select End Sub ' the procedure called above to create a SQL String Private Function qryActSummaryRptBaseSummary() 10 On Error GoTo PROC_ERROR 15 qryActSummaryRptBaseSummary = "SELECT qryActSummaryRptBase.CompanyName, qryActSummaryRptBase.BuySell, Sum(qryActSummaryRptBase.DealNomVol) AS SumOfDealNomVol, " & _ "Sum(qryActSummaryRptBase.DealNomCost) AS SumOfDealNomCost, Sum(qryActSummaryRptBase.NomVol) AS SumOfNomVol, " & _ "Sum(qryActSummaryRptBase.ActVol) AS SumOfActVol, Sum(qryActSummaryRptBase.CostNom) AS SumOfCostNom, " & _ "Sum(qryActSummaryRptBase.CostAct) As SumOfCostAct " & _ "FROM (SELECT tblBuyOrSell.strBuyOrSell AS BuySell, vwAS.strCompanyName AS CompanyName, " & _ "NomVol.SumOflngVolume AS DealNomVol, NomVol.NomCost AS DealNomCost, " & _ "Sum(vwAS.lngNominalVolume) AS NomVol, Sum(vwAS.lngActualVolume) AS ActVol, " & _ "Sum(([curPrice]+[curPricingPremiumDiscount])*[lngNominalVolume]) AS CostNom, Sum(([curPrice]+[curPricingPremiumDiscount])*[lngActualVolume]) AS CostAct " & _ "FROM (vwActivitySummary AS vwAS LEFT JOIN (SELECT tvConfirmations.lngContractNo, tvConfirmations.lngCustomerID, Sum(tvConfirmationDetails.lngVolume) AS SumOflngVolume, " & _ "tvConfirmations.bytBuyOrSell, Sum(([curPrice]+[curPricingPremiumDiscount])*[lngVolume]) AS NomCost " & _ "FROM (tvConfirmations RIGHT JOIN tvConfirmationDetails ON tvConfirmations.lngContractNo = tvConfirmationDetails.lngContractNo) " & _ "LEFT JOIN tvMarketAreas ON tvConfirmations.lngMarketAreaID = tvMarketAreas.lngMarketAreaID " & _ "WHERE (((tvConfirmationDetails.dtTransaction) Between #" & CDate(Me.ctDropDateStart) & " # And #" & CDate(Me.ctDropDateEnd) & "#) ) " & _ "GROUP BY tvConfirmations.lngContractNo, tvConfirmations.lngCustomerID, tvConfirmations.bytBuyOrSell) AS NomVol " & _ "ON (vwAS.lngContractNo = NomVol.lngContractNo) AND (vwAS.bytBuyOrSell = NomVol.bytBuyOrSell) " & _ "AND (vwAS.lngCustomerID = NomVol.lngCustomerID)) " & _ "RIGHT JOIN tblBuyOrSell ON vwAS.bytBuyOrSell = tblBuyOrSell.bytBuyOrSell " & _ "WHERE (((vwAS.dtTransaction) Between #" & CDate(Me.ctDropDateStart) & " # And #" & CDate(Me.ctDropDateEnd) & "#) AND ((vwAS.lngCustomerID) Not In (381))) " & _ "GROUP BY tblBuyOrSell.strBuyOrSell, vwAS.strCompanyName, NomVol.SumOflngVolume, NomVol.NomCost " & _ "ORDER BY vwAS.strCompanyName )as qryActSummaryRptBase " & _ "GROUP BY qryActSummaryRptBase.CompanyName, qryActSummaryRptBase.BuySell " & _ "ORDER BY qryActSummaryRptBase.CompanyName, qryActSummaryRptBase.BuySell;" ' Me.ctDropDateStart and Me.ctDropDateEnd - references a calender control on the calling form. PROC_EXIT: 30 On Error Resume Next 40 Exit Function PROC_ERROR: 50 Select Case Err.Number 'Case ### Case Else 60 fLogError Err.Number, Erl, Err.Description, "Form_frmRPTActivitySummary", "qryActSummaryRptBaseSummary", True 70 Resume PROC_EXIT 80 End Select End Function
There are currently 1 users browsing this thread. (0 members and 1 guests)
Bookmarks