Averaging a recordset column

felipedmc

New Member
Joined
Nov 29, 2012
Messages
10
Hey there!

I created a VBA application in my Acess database. This application generates lots of worksheets within lots of workbooks to calculate meteorological stuff. I am trying to calculate the average of a column in a recordset containing data retrieved from my access database. This recordset is used to fill sheets in my workbooks.

I mean. For each meteorological station i create a workbook with 12 worsheets (one sheet for each month of the year). I fill those worksheets querying my database within a loop from 1 to 12. In each step of my loop the recordset contains a column with a date and another colum with pluviosity totals (just numbers). I just wanna calculate the average of this totals column and put it into a previously created worbook to agregate all the stations and its monthly averages (the translation to portuguesE of AVERAGE is MÉDIA). Here's my perfectly working code till now:

Code:
Public Function createFillWorkbooks() As String
    
    'Excel objects    
    Dim objXL As Excel.Application
    Dim avgXL As Excel.Application
    Dim objWbk As Excel.Workbook
    Dim avgWbk As Excel.Workbook
    Dim objWks As Excel.Worksheet
    Dim avgWks As Excel.Worksheet
    Dim objRng As Excel.Range
    
    
    'Miscelaneous objects
    Dim objTable As AccessObject
    Dim rcdSet As Recordset
    Dim qryDef As QueryDef
    Dim codMon As Integer, _
        totalAvg As Integer
    Dim codSt As String
    Dim strPath As String, _
        strAvgPath As String, _
        strSheetName As String, _
        strRng As String, _
        strMon As String, _
        strSQL As String
    
    'setup the MEDIAS - ANA table
    Set avgXL = New Excel.Application
    avgXL.SheetsInNewWorkbook = 1
    avgXL.Visible = True
    strAvgPath = CurrentProject.Path & "\" & "mediasANA.xls"
    If testFileExistence(strAvgPath) Then
        Set avgWbk = avgXL.Workbooks.Open(strAvgPath)
        avgWbk.Save
    Else
        Set avgWbk = avgXL.Workbooks.Add
        avgWbk.SaveAs FileName:=strAvgPath, ReadOnlyRecommended:=False
    End If
    Set avgWks = avgWbk.Worksheets(1)
    avgWks.Name = "Médias"
            
    For Each objTable In Application.CurrentData.AllTables
        If (objTable.Name = "Chuvas") Then
            
            'setup the station workbook and recordset
            strSQL = "SELECT DISTINCT EstacaoCodigo as stCode FROM " & objTable.Name
            Set rcdSet = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
            codSt = rcdSet!stCode
            If rcdSet.RecordCount <> 1 Then
                Debug.Print "More than one station in table " & objTable.Name
                rcdSet.MoveFirst
            End If
            strPath = CurrentProject.Path & "\" & codSt & ".xls"
            Set objXL = New Excel.Application
            objXL.SheetsInNewWorkbook = 1
            objXL.Visible = True
            If testFileExistence(strPath) Then
                Set objWbk = objXL.Workbooks.Open(strPath)
                objWbk.Save
            Else
                Set objWbk = objXL.Workbooks.Add
                objWbk.SaveAs FileName:=strPath, ReadOnlyRecommended:=False
            End If
            objWbk.Activate
            Set rcdSet = Nothing
            
            'update query for each month of the year and fill sheets in current workbook
            For codMon = 1 To 12
                strSQL = "SELECT Data,Total FROM " & objTable.Name & " WHERE Month(Data) = " & codMon
                Set rcdSet = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
                If testSheetExistence(objWbk, codSt & MonthName(codMon)) Then
                    Set objWks = objWbk.Sheets(codSt & MonthName(codMon))
                Else
                    Set objWks = objWbk.Sheets.Add
                    objWks.Name = codSt & MonthName(codMon)
                    objWks.Columns(1).Name = "Data"
                    objWks.Columns(2).Name = "Total"
                End If
                If testSheetExistence(objWbk, "Sheet1") Then
                    objWbk.Sheets("Sheet1").Delete
                    Debug.Print "DELETANDO SHEET1"
                ElseIf testSheetExistence(objWbk, "Plan1") Then
                        objWbk.Sheets("Plan1").Delete
                        Debug.Print "DELETANDO PLAN1"
                Else
                    Debug.Print "SHEET1 NÃO ENCONTRADA"
                End If
                Set objRng = objWks.Range("A1")
                objRng.CopyFromRecordset rcdSet
                objWks.Columns.AutoFit
                Set rcdSet = Nothing
            Next codMon
            objWbk.Save
        End If
    Next objTable
End Function

thank you for the help
 
Last edited:

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Of course, instead of calculating the average from the recordset column, I perfectly could calculate it from the Excel.Worksheet column. But I just can't find a away to use Excel functions ...
 
Upvote 0

Forum statistics

Threads
1,221,310
Messages
6,159,176
Members
451,543
Latest member
cesymcox

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top