VBA to add Totals to subform (1 Viewer)

[ebs17]

Someone like me who simply thinks would simply use a separate query in a separate subform for the totals.
Visually you can then put it together so that it looks like one form.

 

[Gasman]

Ok, got curious now.

I have a datasheetform that gets it's data from a query.
Query is

Form is

No code added yet.

 

[Gasman]

You have to be careful with that code, as it has buggered up my query.
I can get the totals row and select an option, but then nothing is shown.

 

[Gasman]

OK, got it working, but with query as subform control source.

 

[bodders24]

OK, got it working, but with query as subform control source.
View attachment 108012

How did you set the total cells - manually ?

 

[CJ_London]

There is something missing

This is the properties for a query originally created in code as per the OP (we don't have the full code so may be something missing)

and for one of the columns where the aggregate type was set to 0

Note the aggregatetype is -1 - so the change did not get saved

Now open the query and set the totals and save - lots more properties are created for the query

and the aggregate type has changed to 0

Edit: forgot my conclusion - which is you need to refresh the database window. From the above you can conclude that for it to work, some of the properties are utilised by the query object, not the querydef.

This code works for me

Child1.SourceObject = ""
    Set db = CurrentDb
    
    Set qdf = db.CreateQueryDef("query1c", "SELECT * FROM Table2 LEFT JOIN Table1 ON Table2.pk = Table1.pk")
    RefreshDatabaseWindow
    qdf.Properties.Append qdf.CreateProperty("TotalsRow", dbBoolean, True)
    qdf.Fields("someFK").Properties("AggregateType") = 0
    qdf.Fields("table1.pk").Properties("AggregateType") = 0
    qdf.Close
    Child1.SourceObject = "query.query1c"

@bodders24 - I asked before for you to provide the whole code, not just the bit that didn't work. You didn't, So I had to mock up what I thought you might be doing. In the future, if you are asked to provide the whole code, please do, it will save everyone a lot of time

 

[Gasman]

How did you set the total cells - manually ?

No set in the query.
Do you think I am going to get that accuracy doing it manually?

 

[Gasman]

There is something missing

This is the properties for a query originally created in code as per the OP (we don't have the full code so may be something missing)
View attachment 108008
and for one of the columns where the aggregate type was set to 0
View attachment 108009

Note the aggregatetype is -1 - so the change did not get saved

Now open the query and set the totals and save - lots more properties are created for the query
View attachment 108010
and the aggregate type has changed to 0
View attachment 108011

@CJ_London
How do you get that info?
I went into the locals, but it was item after item many levels deep.

 

[CJ_London]

just a notification I have updated my previous post with a solution

@Gasman - from the database documenter on the ribbon

 

[bodders24]

As requested here is all the code used to rebuild the table and subform. I *think* the problem is somewhere in the subform properties.

Also thanks for all the help and advice so far - it's been very useful

The complete code exceeds the character limit for posting here, so here is just the proc for rebuilding the subform:

On Error GoTo RebuildSubForm_Error
'
'---------------------------------------------------------------------------------------
' Procedure : RebuildSubForm
'
' DateTime  : 14/05/2023
'
' Author    : Nick Boddington
'
' Purpose   :
'
'---------------------------------------------------------------------------------------
'                            AMENDMENTS
'---------------------------------------------------------------------------------------
' Date       | Author           | Details of change
'---------------------------------------------------------------------------------------
'
'---------------------------------------------------------------------------------------
'------------------------------------------------
'Access Variables
'------------------------------------------------
Dim frm                     As Form
Dim ctl                     As control
Dim lbl                     As Label
Dim txt                     As TextBox
Dim obj                     As Object
'------------------------------------------------
'DAO Variables
'------------------------------------------------
Dim rstXT                   As DAO.Recordset
Dim dbs                     As DAO.Database
Dim qdf                     As DAO.QueryDef
'------------------------------------------------
'DAO Variables
'------------------------------------------------
Dim intCount                As Integer
Dim strDescField            As String
Dim lngEndMS                As Long
Dim lngStartMS              As Long
Dim intControlCount         As Integer
'
'------------------------------------------------
'Remove existing controls from subform
'in reverse order
'------------------------------------------------
lngStartMS = timeGetTime
Set dbs = CurrentDb
DoCmd.OpenForm strSubForm, acDesign, , , , acHidden
Set frm = Forms(strSubForm)
intControlCount = frm.Controls.count
For intCount = frm.Controls.count - 1 To 0 Step -1
    DeleteControl frm.Name, frm.Controls(intCount).Name
Next
lngEndMS = timeGetTime
gastrTimings(intTimingCount) = intTimingCount + 1 & " ; Remove control from crosstab form : " & strSubForm & ";" & lngEndMS - lngStartMS & ";" & intControlCount
intTimingCount = intTimingCount + 1
'------------------------------------------------
'Default datasheet settings
'------------------------------------------------
lngStartMS = timeGetTime
With frm
    .DatasheetFontName = "SegoeUI"
    .DatasheetFontHeight = 10
    .RowHeight = 300
    '.Properties("TotalsRow") = True
End With
'------------------------------------------------
'Add controls to subform based on the crosstab query
'------------------------------------------------
lngStartMS = timeGetTime
Set dbs = CurrentDb
Set frm = Forms(strSubForm)
Set rstXT = dbs.OpenRecordset(strXTabQuery, dbOpenDynaset)
For intCount = 0 To rstXT.Fields.count - 1
    If rstXT.Fields(intCount).Name <> "Sequence" Then
        Set txt = CreateControl(frm.Name, acTextBox, acDetail)
        txt.ControlSource = rstXT.Fields(intCount).Name
        txt.Name = "txt" & rstXT.Fields(intCount).Name
        If rstXT.Fields(intCount).Name = strDescField Then
            txt.Tag = "Descfield"
        End If
        rstXT.Fields(intCount).Properties("AggregateType") = 0
        Set lbl = CreateControl(frm.Name, acLabel, acDetail, txt.Name)
        lbl.Caption = rstXT.Fields(intCount).Name
    End If
Next
rstXT.Close
Set rstXT = Nothing
'
'------------------------------------------------
'Add AggregateType to querydef columns
'------------------------------------------------
If blnAddTotals = True Then
    Set qdf = dbs.QueryDefs("qselBudgetXT")
    qdf.Properties("TotalsRow") = True
     For intCount = 2 To qdf.Fields.count - 1
        qdf.Fields(intCount).Properties("AggregateType") = 0
     Next
     qdf.Close
End If
lngEndMS = timeGetTime
gastrTimings(intTimingCount) = intTimingCount + 1 & " ; Add controls to crosstab form : " & strSubForm & ";" & lngEndMS - lngStartMS & ";" & frm.Controls.count
intTimingCount = intTimingCount + 1
'------------------------------------------------
'Format controls
'------------------------------------------------
For Each ctl In frm.Controls
    If TypeOf ctl Is TextBox Then
        Set txt = ctl
        If txt.Tag <> "Descfield" Then
            txt.ColumnWidth = 3 * gcintTwipsPerCm
            txt.Format = "£#,##0.00"
            txt.TextAlign = 2
            txt.FontName = "Segoe UI"
            txt.FontSize = 10
        Else
            txt.ColumnWidth = 5 * gcintTwipsPerCm
        End If
        If HasProperty(ctl, "AggregateType") = False Then
            Set obj = ctl
            obj.Properties.Append dbs.CreateProperty("AggregateType", dbLong, acAggregateSum)
        Else
            ctl.Properties("AggregateType") = acAggregateSum
        End If
        'On Error Resume Next
        'ctl.Properties("AggregateType") = 0
    End If
Next
'
'If HasProperty(frm, "TotalsRow") = False Then
'    Set obj = frm
'    obj.Properties.Append dbs.CreateProperty("TotalsRow", dbBoolean, True)
'End If
lngEndMS = timeGetTime
gastrTimings(intTimingCount) = intTimingCount + 1 & " ; Format controls on crosstab form : " & strSubForm & ";" & lngEndMS - lngStartMS & ";" & frm.Controls.count
intTimingCount = intTimingCount + 1
frm.sou
DoCmd.Close acForm, frm.Name, acSaveYes
'

    


'
Exit_RebuildSubForm:
Exit Sub
RebuildSubForm_Error:
      If Err.Number < 0 Then
            'For errors being passed here from a subsequent proc
            Err.Raise vbObjectError + 2, "", Err.Description & vbNewLine & "Passed to module/proc : modFunctions/RebuildSubForm"
      Else
            'For errors raised in this proc
            Err.Raise vbObjectError + 2, "", "Error " & Err.Number & " : " & Err.Description & vbCrLf & "Raised in module/proc : modFunctions/RebuildSubForm"

      End If
Resume Exit_RebuildSubForm
'
End Sub

 

[Gasman]

Here is my query.
I *think* the -1 might be where the Totals text is shown? Just guessing though.

 

[Gasman]

I can get the totals to show with this code?

Private Sub Form_Open(Cancel As Integer)
Dim qdf As DAO.QueryDef
Dim db As DAO.Database

Set db = CurrentDb
Set qdf = db.QueryDefs("qryWeeklyList")

qdf.Properties("TotalsRow") = False
qdf.Fields(2).Properties("AggregateType") = 1
qdf.Fields(3).Properties("AggregateType") = 1
qdf.Fields(4).Properties("AggregateType") = 1
qdf.Close
Me.qryWeeklyListsubform.Form.Recordset.Requery
End Sub

Note that I inadvertently left the totalsrow as False, yet still works.?
Again subform control source is query not form.

Last row appears to be an average? .

 

[CJ_London]

@Gasman -1 simply means no aggregatetype selected (i.e. none in the dropdown). In the first column, it displays 'Total' rahter than nothing, but you can select an aggregatetype in that column if you want.

@bodders24 - So nothing like what you have been showing us. Given you are using a datasheet there is no point in creating a subform, just use the query as previously advised. You are just creating work for yourself. If you ever had to provide a .accde rather than a .accdb, your form manipulation code would fail anyway.

Would have thought all you would need would be something like

If blnAddTotals = True Then
    Set qdf = dbs.QueryDefs("qselBudgetXT")
    qdf.Properties("TotalsRow") = True
     For intCount = 2 To qdf.Fields.count - 1
        qdf.Fields(intCount).Properties("AggregateType") = 0
        'code to format the columns in your form would be applied to your querydef (note that font settings apply to the whole sheet, not specific columns)

 Next

     RefreshDatabaseWindow
     qdf.Close
    me(strSubForm).sourceobject="query.qselBudgetXT" 'assumes this code is run in the form that has the subform
End If

The only thing I can think of you can do in a form datasheet rather than a query datasheet is conditional formatting and I don't see you doing that

 

[Gasman]

I think you just need to run the code once, as I can comment the code out and still get totals.?

Private Sub Form_Open(Cancel As Integer)
'Dim qdf As DAO.QueryDef
'Dim db As DAO.Database
'
'Set db = CurrentDb
'Set qdf = db.QueryDefs("qryWeeklyList")
'
'qdf.Properties("TotalsRow") = False
'qdf.Fields(1).Properties("AggregateType") = 1
'qdf.Fields(2).Properties("AggregateType") = 1
'qdf.Fields(3).Properties("AggregateType") = 1
'qdf.Fields(4).Properties("AggregateType") = 1
'
'qdf.Close
'Me.qryWeeklyListsubform.Form.Recordset.Requery
End Sub

 

[bodders24]

so what happened when you used the query as the subform control source object?

works for me
View attachment 108005

CJ - Finally the penny has dropped & I see what you meant. It's all working now - many thanks for your patience & help.

Bodders

 

[CJ_London]

I wouldn’t normally recommend users interacting directly with a query as a subform source or otherwise. But in this case the query is a crosstab potentially with an unknown number of columns and column names but more importantly, it isn’t editable.

I might use it for a select query but would change the recordset type to snapshot so the data isn’t editable

 

[apr pillai]

I have built a procedure to dynamically rebuild a subform and underlying table based on a crosstab query. This is so that it can show various combinations of categories (rows) and monthly totals (columns). I would like to have a total row appearing on the form and to use VBA to achieve this. The subform is based on a select query from the calculated table.

I have read several posts, and I think this is the code to do so:

    Set qdf = dbs.QueryDefs("qselBudgetXT")
    qdf.Properties("TotalsRow") = True
     qdf.Fields(2).Properties("AggregateType") = 0
     qdf.Fields(3).Properties("AggregateType") = 0
     qdf.Fields(4).Properties("AggregateType") = 0
     qdf.Fields(5).Properties("AggregateType") = 0
     qdf.Close

However, the subform shows a Totals row, but no actual totals in the cells in that row. I can add them manually but that defeats the object.

View attachment 107989

Does anyone have any thoughts or suggestions. All help gratefully received.

Thanks

Bodders

Check this Blogpost can help you out: https://www.msaccesstips.com/2008/11/sum-min-max-avg-paramarray.html

 

[Gasman]

Strangely, I had to revisit this as I spotted this code in my Daily Form, which is a datasheet. That was the one I displayed previously in this thread.
The only code in the form is

Private Sub Form_Open(Cancel As Integer)
Dim qdf As DAO.QueryDef
Dim db As DAO.Database

Set db = CurrentDb
Set qdf = db.QueryDefs("qryWeeklyList")

qdf.Properties("TotalsRow") = True
qdf.Fields(2).Properties("AggregateType") = 1
qdf.Fields(3).Properties("AggregateType") = 1
qdf.Fields(4).Properties("AggregateType") = 1
qdf.Close
Me.Requery

End Sub

but I no longer get the totals.?
Not sure how long that has been going on for.
Like the O/P I still get the totals in the naked query.

Belay that.
Just went into the query and they no longer show. ?

I can select Sum from the dropdown, but nothing shows.?