Results 1 to 3 of 3
  1. #1
    DMT Dave is offline VIP
    Windows 10 Access 2016
    Join Date
    May 2018
    Posts
    1,185

    rs Totals

    Hi Guys, is there a method of adding data to another Excel worksheet if the recordset totals exceed ie 40 records and the totals to excel cells after recordset on worksheet 2 if the recordset does exceed 40 records then add a bottom border ?

    For example, my template can only print on worksheet 1 if the recordset count is lower than 40 then totals could always be cells (41, 5) (41, 6) and (41, 7) * this is fine until after 40 records

    I currently add the totals to the right of the recordset (cells 11,12 and 13 on worksheet 1)

    PS: HOPE THIS MAKES SENSE



    Code:
    With xlWB.Worksheets(1).Cells(6, 2).CopyFromRecordset rs
    .Worksheets(1).Cells(7, 11) = TotalNett
    .Worksheets(1).Cells(7, 12) = TotalVat
    .Worksheets(1).Cells(7, 13) = TotalAll
    .Worksheets(1).Cells(2, 3) = Me.cboSelectMR
    .Worksheets(1).Cells.EntireColumn.AutoFit

  2. #2
    Join Date
    Apr 2017
    Posts
    1,673
    Add some rows above table header, and put your totals there! The best will be when you use SUBTOTAL() to calculate them, then whenever you set an autofilter for your table, only visible rows are summarized!

    And you are in wrong forum btw!

  3. #3
    RayMilhon is offline VIP
    Windows 7 64bit Access 2010 32bit
    Join Date
    Aug 2011
    Location
    Southern California
    Posts
    1,065
    I have 2 Excel Workbooks that I populate 45 Worksheets from 45 Tables in SQL Server. The Last Row on each worksheet contains a Total Count of how many Records were in the table. This ranges from 0 To 1500 This is my code:

    Code:
    strSQL = "SELECT * FROM worksheets;"
    
    rs.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
    
    Do Until rs.EOF
        irow = rs!startrow
        WSName = rs!Worksheet
        Debug.Print WSName
        WSlastcol = rs!endcol
        xlApp.Workbooks(rs!file).Sheets(WSName).Activate
        strSQL = "Select * From " & rs!Table
        'With xlApp.Workbooks(WBName).Sheets(rs!Worksheet)
        rsout.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
        lpctr = 1
        Do Until rsout.EOF
            strSQL = "Select * From tbl_worksheetformats Where Worksheet = """ & rs!Worksheet & """"
            WS.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
            Do Until WS.EOF
                Set cell = xlApp.Workbooks(rs!file).Sheets(WSName).Cells(irow, WS!Column)
                strfld = WS!Field
                cell.Value = rsout.Fields(strfld)
                'cell.Font = "Times New Roman"
                cell.Font.Size = 8
                'cell.Borders.LineStyle = xlAutomatic
                'cell.Borders (xlAll)
                'Set all borders to continuous and thin
                With cell.Borders
                    .LineStyle = xlContinuous
                    .Weight = xlMedium
                    'Sets the border color to RGB value. See Interior row above for more color options
                    .Color = RGB(255, 255, 255)
                End With
                'Set only top border as continuos and thin
                'With Range("A1").Borders(xlEdgeTop)
                '.LineStyle = xlContinuous
                '.Weight = xlThin
                'End With
                If WSCols < WS!Column Then WSCols = WS!Column
                WS.MoveNext
            Loop
            
            WS.Close
            irow = irow + 1
            rsout.MoveNext
            lpctr = lpctr + 1
        Loop
        If lpctr = 1 Then
            Set cell = xlApp.Workbooks(rs!file).Sheets(WSName).Cells(14, WSlastcol)
            cell.Value = 0
            sitot = 0
            cell.Font.Bold = True
            cell.Font.Size = 8
            Set cell = xlApp.Workbooks(rs!file).Sheets(WSName).Cells(14, WSlastcol - 1)
            cell.Value = "Total Count:"
            cell.Font.Bold = True
            cell.Font.Size = 8
            
        Else
            Set cell = xlApp.Workbooks(rs!file).Sheets(WSName).Cells(irow, WSlastcol)
            cell.Value = lpctr - 1
            sitot = lpctr - 1
            cell.Font.Bold = True
            cell.Font.Size = 8
            Set cell = xlApp.Workbooks(rs!file).Sheets(WSName).Cells(irow, WSlastcol - 1)
            cell.Value = "Total Count:"
            cell.Font.Size = 8
            cell.Font.Bold = True
        End If
        strSQL = "Select Row From tbl_system_inventory Where WS = """ & WSName & """"
        rssysteminv.Open strSQL, CurrentProject.Connection, adOpenForwardOnly, adLockReadOnly
        If Not rssysteminv.EOF Then
            Set cell = xlApp.Workbooks(1).Sheets("III System Inventory").Cells(rssysteminv!Row, 3)
            cell.Value = sitot
        End If
        rssysteminv.Close
        rsout.Close
        Set cell = xlApp.Workbooks(rs!file).Sheets(WSName).Cells(3, 1)
        cell.Value = StartDate() & " Through " & EndDate()
        'End With
        rs.MoveNext
        'WSCols = 0
    Loop
    Set cell = xlApp.Workbooks(1).Sheets("III System Inventory").Cells(1, 2)
    cell.Value = "Weekly Report"
    Set cell = xlApp.Workbooks(1).Sheets("III System Inventory").Cells(1, 3)
    cell.Value = "HVVMG"
    Set cell = xlApp.Workbooks(1).Sheets("III System Inventory").Cells(1, 4)
    cell.Value = StartDate() & " Through " & EndDate()
    rs.Close
    xlApp.Workbooks(1).Save
    xlApp.Workbooks(2).Save
    xlApp.Workbooks.Close
    
    
    Call Masteremail
    Exit Sub
    ErrHandler:
    
    End Sub
    As you can see it calculates the row and puts the total in the last row prior to saving the workbook. Hopefully you can adapt this to your needs.

Please reply to this thread with any new information or opinions.

Similar Threads

  1. Query detail totals vs. Summary Totals do not match?
    By aellistechsupport in forum Queries
    Replies: 9
    Last Post: 01-15-2016, 11:36 AM
  2. Similar to totals and Grand totals
    By Thompyt in forum Reports
    Replies: 14
    Last Post: 01-24-2015, 06:39 PM
  3. Unusual Sub Totals & Totals in Groups.
    By Robeen in forum Reports
    Replies: 12
    Last Post: 03-20-2012, 08:55 AM
  4. Replies: 5
    Last Post: 12-06-2011, 11:18 AM
  5. Month totals and Year totals
    By marksnwv in forum Access
    Replies: 1
    Last Post: 08-05-2011, 10:13 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Other Forums: Microsoft Office Forums