last row of data

[hellohello1]

The code below exports a crosstab query with 2 parameters to Excel. It works great.

Now I am trying to add a Total row to the bottom row of my data in Excel to count non-blank cells starting at column G.

I ran a macro and the code for cell G113 would be:
ActiveCell.FormulaR1C1 = "=COUNTA(R[-111]C:R[-1]C)"

How can I tell the code to go to the row after the last row of data. Then put the word 'Total' in Column A and put the COUNTA formula in all the columns where there is data-- starting with column G? (Column A-F is information such as Project Name, Size and Date and don't need formulas).



This is the code that exports the query and does some formatting:
'---------------------------------------------------------------------------------------
' Procedure : Send2Excel
' Author : Bob Larson
' Date : 5/25/2008
' Purpose : Send any single recordset form to Excel. This will not work with
' subforms.
' Use : You may freely use this code as long as the author information in
' this header remains intact
'---------------------------------------------------------------------------------------
Public Function Send2Excel(qry As String, Optional strSheetName As String)
' qry is the name of the query you want to send to Excel
' strSheetName is the optional name of the sheet you want to name it to

Dim rst As DAO.Recordset
Dim ApXL As Object
Dim xlWBk As Object
Dim xlWSh As Object
Dim fld As Field
Const xlCenter As Long = -4108
Const xlBottom As Long = -4107

On Error GoTo err_handler


Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim prm As DAO.Parameter
Set db = CurrentDb
Set qdf = db.QueryDefs(qry)
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset

'check to see if there is data. If not, display a message and exit the function
If rst.RecordCount = 0 Then
MsgBox "Your report selection returned no data", , "No data"
Exit Function
End If


Set ApXL = CreateObject("Excel.Application")
Set xlWBk = ApXL.Workbooks.Add
ApXL.Visible = True

Set xlWSh = xlWBk.Worksheets("Sheet1")
If Len(strSheetName) > 0 Then
xlWSh.Name = Left(strSheetName, 34)
End If
xlWSh.Range("A1").Select


For Each fld In rst.Fields
ApXL.ActiveCell = fld.Name
ApXL.ActiveCell.Offset(0, 1).Select
Next

rst.MoveFirst
xlWSh.Range("A2").CopyFromRecordset rst
xlWSh.Range("1:1").Select

' formatting for the first row (1:1)
With ApXL.Selection.Font
.Name = "Arial"
.Size = 10
.Bold = True
End With

With ApXL.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = True
End With

' selects all of the cells
ApXL.ActiveSheet.Cells.Select

' does the "autofit" for all columns
ApXL.ActiveSheet.Cells.EntireColumn.AutoFit

'set page to Landscape
ApXL.ActiveSheet.PageSetup.Orientation = 2

'make the column headers vertical (90 degrees)
xlWSh.Range("1:1").Select
ApXL.Selection.Orientation = 90

'add header (title) and footer (page numbers) and repeat title rows and make paper legal size.
ApXL.ActiveSheet.PageSetup.CenterHeader = "Escalation Report for " & Forms!frmEscalationReports!cboEscalation.Column(1)
ApXL.ActiveSheet.PageSetup.LeftFooter = "Page &P of &N"
ApXL.ActiveSheet.PageSetup.PrintTitleRows = "$1:$1"
ApXL.ActiveSheet.PageSetup.PaperSize = xlPaperLegal

'make Row 1 gray
With ApXL.Intersect(xlWSh.Range("A1").CurrentRegion, xlWSh.Rows(1))
.Interior.ColorIndex = 15
.Interior.Pattern = xlSolid
End With

'adjusts the column size for column 2 and 3 and row height for row 1.
xlWSh.Columns("B:B").ColumnWidth = 22
xlWSh.Columns("C:C").ColumnWidth = 49
xlWSh.Rows("1:1").RowHeight = 73.5

'adds the autofilter to the first row
ApXL.Selection.AutoFilter

'add table border
With xlWSh.Range("A1").CurrentRegion
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
End With

'set freeze panes
xlWSh.Rows("2:2").Select
ApXL.ActiveWindow.FreezePanes = True

'delete Sheet2 and Sheet3
xlWBk.Sheets(Array("Sheet2", "Sheet3")).Select
xlWBk.Sheets("Sheet3").Activate
ApXL.ActiveWindow.SelectedSheets.Delete

' selects the first cell to unselect all cells
xlWSh.Range("A1").Select

rst.Close
Set rst = Nothing

Exit Function
err_handler:
DoCmd.SetWarnings True
MsgBox Err.Description, vbExclamation, Err.Number
Exit Function

End Function

Thanks!

 

[PHV]

Use the rst.RecordCount property to calculate the number of rows in your sheet.

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[hellohello1]

Thanks for writing PHV.

I got the answer. It is:

With xlWSh

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
.Cells(LastRow + 1, "A").Value = "Total"
.Cells(LastRow + 1, "G").Resize(, LastCol - 6).FormulaR1C1 = "=COUNTA(R2C:R[-1]C)"
End With

 

[SkipVought]

Now I am trying to add a Total row to the bottom row of my data in Excel to count non-blank cells starting at column G.

WHY? Why put the aggregation where someone has to page dow to find? Thats a throwback to pencil, paper and adding machine. Put your aggregations AT THE TOP! Freeze your aggregations and heading row, so it ALWAYS visible. It's REALLY a big plus+++

Skip,
[sup]Don't let the Diatribe...
talk you to death![/sup][sub]
Just traded in my old subtlety...
for a NUANCE![/sub]

 

[hellohello1]

Hi Skip,

How's my favorite Tek-Tips Texan?

The boss-lady wanted totals at the bottom, so that is what I tried to do.