Help needed Writing formula that totals data at end of column

Please can anyone help me. I have created an Access 97 Database that
does a large Sql query stored on a remote server and outputs to multiple
Excel Worksheets.
It also copies a logo from the access form and pastes it on each
worksheet.

The code uses two sql inputs one to get the contractnames which is the
criteria for the second sql that contains the main data. As I do not
know in advance before running the query what contracts will be
captured.

Each of the contracts is put on to a new worksheet.

The problems I am trying to solve is on each of the worksheets in Excel
I am trying to put a total of Column "J" at the bottom of column "J" the
next blank cell and format it to bold with an underline.

On each of the sheets I do not know how many rows of Data column "J"
will have in advance. I have tried xldown and ofsets but I am not having
much success.

Here is my Code.

Private Sub ExportMultipleworksheets_Click()
Dim objExc As Excel.Application
Dim shts As Excel.Worksheet
Dim wkbk As Excel.Workbook
Dim Rge As Excel.Range
Dim Fld As Variant

Dim DB As DAO.Database
Dim Rst_1 As DAO.Recordset
Dim Rst_2 As DAO.Recordset
Dim SQL_1 As String, SQL_2 As String
Dim strPath As String, FldName As String
Dim varRows As Variant
Dim strFileName As String
Dim rng As Excel.Range 'This is for calculating column "J "
Dim astRow As Excel.Range 'This is for calculating the last row in
column "J "

Dim I As Integer, SheetCount As Integer
Dim FileName As String, FirstSheet As String

On Error GoTo Err_Handler


Set DB = CurrentDb()
'"SELECT Table1.Address FROM Table1 GROUP BY Table1.Address"
SQL_2 = "SELECT PaymentCertificatetmp.ContractName FROM
PaymentCertificatetmp GROUP BY PaymentCertificatetmp.ContractName"
'select the grouped contracts
Set Rst_2 = DB.OpenRecordset(SQL_2)

Dim strFilter As String
SetStatus "Getting Data for Export ......Please Wait ....."
'this sets the windows open save filters to be excel
strFilter = ahtAddFilterItem("Excel Files (*.xls)", "*.xls")
'This calls the windows open save window
strsavefilename = ahtCommonFileOpenSave( _
OpenFile:=False, _
Filter:=strFilter, _
Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)

SetStatus "Transferring Data to Spreadsheet ..... Please
Wait ....."


Me.logo.SetFocus 'this just goes to the logo field so that it can be
copied
DoCmd.RunCommand acCmdCopy 'this copies the logo into memory
Me.cmbOrganisation.SetFocus



FileName = strsavefilename
strPath = strsavefilename


'This calls a save file api and works but it is not the standard windows
open save api.
'FileName = InputBox("Enter the name of the file to be saved." & Chr(13)
& Chr(13) & " The file will be saved in C:\Temp.")
'strPath = "c:\temp" & "\" & FileName & ".xls" 'same the file on the
same path of the db.



Set objExc = New Excel.Application

If Len(FileName & "") > 0 Then 'Only run the file if the input
box has a name of the file
Set wkbk = objExc.Workbooks.add 'create a new workbook

Do Until Rst_2.EOF
FldName = Rst_2.Fields("ContractName")
Set shts = wkbk.ActiveSheet
wkbk.Sheets.add
' Add a new sheet to copy new data to
SQL_1 = "SELECT ContractName as Contract,OrderNumber as [Order
No],DepotName,EstimateNo,ExchArea,RateCode as NIMS,Description,Planned +
DFE as Qty,Rate,Qty*Rate as Total FROM PaymentCertificatetmp WHERE
ContractName = '" & FldName & "'" 'Fiter by each ContractName
Set Rst_1 = DB.OpenRecordset(SQL_1)

I = 1
With Rst_1
For Each Fld In .Fields 'place the field names in
the excel A1 row.
With shts '!!!!put all the custom changes here to go on
all sheets!!!!!
.Cells(1, 6).RowHeight = 62 ' this sets the row
height for the log that will be pasted last as this area will paste the
logo as many times as their are contracts otherwise
.Cells(2, 1).Value = "Payment Certificate: "
.Cells(2, 8).Value = "Week Ending: "
.Cells(3, 1).Value = "Subcontractor: "
.Cells(3, 8).Value = "Purchase Order: "


.Cells(4, I) = Fld.Name 'this sets the row to put
the column names eg(2,1) is row 2 column 1
I = I + 1
objExc.ActiveWindow.Zoom = 95
End With
Next
End With

'this sets the column fonts
to bold eg(4,1) = row 4 column 1
Set Rge = shts.Rows("4:1") 'set the range to the
fiRst_1 row in order to adjust the font and alignment
Rge.Font.Bold = True ' Make the row bold
Rge.HorizontalAlignment = xlCenter ' align to the center


Set Rge = shts.Cells(5, 1) 'say where to start copying the
data. eg (3,1) = row 3 column 1
Rge.Font.Name = Ariel 'this sets the font name of the
main data
Rge.Font.Size = 8
Rge.CopyFromRecordset Rst_1 ' Copy the Rst_1 into the
worksheet
Rst_1.Close ' close the recordset before
calling it gain.
Set Rst_1 = Nothing

shts.Columns("A").ColumnWidth = 9.5
shts.Columns("B").ColumnWidth = 12
shts.Columns("C").ColumnWidth = 11
shts.Columns("D").ColumnWidth = 12
shts.Columns("E").ColumnWidth = 16
shts.Columns("F").ColumnWidth = 4.83
shts.Columns("G").ColumnWidth = 62.67
shts.Columns("H").ColumnWidth = 11
shts.Columns("I").ColumnWidth = 11
shts.Columns("J").ColumnWidth = 11
shts.Columns.HorizontalAlignment = xlCenter ' Align all the main
data to center in each column
'shts.Columns.AutoFit ' make the columns autofit to
fit the data

Set Rge = shts.Rows.Cells(1, 7)
Rge.PasteSpecial xlPasteAll 'this pastes the logo on after all
other data so that it only pastes once into each workshee

Set Rge = shts.Columns("I:J")
Rge.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
*********************************************************
*********** THIS IS WHERE I AM HAVING TROUBLE*******
Set rng = shts.Range(Cells(4, "J"), Cells (Rows.Count,
"J").End(xlUp))
Set lastRow = rng(rng.Count).Offset(1, 0)

'TRYING TO PUT TOTAL AT END OF COLUMN JA
**************************************************
******************************************************

'rge.Formula = sum(" & rge(
'Excel.Range("J" & cnt + 11).Formula = "=sum(J4:J" & cnt + 10 &
")"


Set Rge = shts.Rows("2:1") 'Format the second row fonts and
alignment left placed after all other alignment to center has been done
or the other column alingments will overwrite these settings
Rge.Font.Name = Ariel
Rge.Font.Size = 12
Rge.HorizontalAlignment = xlLeft

Set Rge = shts.Rows("3:1") 'format the third row fonts and
alignment
Rge.Font.Name = Ariel
Rge.Font.Size = 12
Rge.HorizontalAlignment = xlLeft


shts.Name = FldName 'Name each of the worksheet tabs
with the contract name


Rst_2.MoveNext

Loop
With wkbk
FirstSheet = .Sheets(1).Name
SheetCount = .Worksheets.Count
.Sheets(FirstSheet).Move After:=.Sheets(SheetCount)
.Sheets(1).Select
End With
wkbk.Close True, strPath 'Save the worksheets
objExc.Quit 'Exit Excel

End If



Exit_Handler:
'clean up
objExc.Quit
Set objExc = Nothing
Set wkbk = Nothing
Set Rge = Nothing
DB.Close
Set DB = Nothing
'Exit Function

Err_Handler:
Select Case err.Number
Case 1004 ' do nothing if the user does
not decide to replace the file
Resume Exit_Handler
Case Else
' MsgBox err.Number & " " & err.Description
End Select

End Sub






*** Sent via Developersdex http://www.developersdex.com ***

Hi Sid,

The simplest way I know of to locate the "end of column" you're looking for
would be to use:

Range("J65536").End(xlUp).Offset(1,0)

This will locate the last row with an entry and then drop one row.

Hope this helps
DS

"sid" wrote:

> Please can anyone help me. I have created an Access 97 Database that
> does a large Sql query stored on a remote server and outputs to multiple
> Excel Worksheets.
> It also copies a logo from the access form and pastes it on each
> worksheet.
>
> The code uses two sql inputs one to get the contractnames which is the
> criteria for the second sql that contains the main data. As I do not
> know in advance before running the query what contracts will be
> captured.
>
> Each of the contracts is put on to a new worksheet.
>
> The problems I am trying to solve is on each of the worksheets in Excel
> I am trying to put a total of Column "J" at the bottom of column "J" the
> next blank cell and format it to bold with an underline.
>
> On each of the sheets I do not know how many rows of Data column "J"
> will have in advance. I have tried xldown and ofsets but I am not having
> much success.
>
> Here is my Code.
>
> Private Sub ExportMultipleworksheets_Click()
> Dim objExc As Excel.Application
> Dim shts As Excel.Worksheet
> Dim wkbk As Excel.Workbook
> Dim Rge As Excel.Range
> Dim Fld As Variant
>
> Dim DB As DAO.Database
> Dim Rst_1 As DAO.Recordset
> Dim Rst_2 As DAO.Recordset
> Dim SQL_1 As String, SQL_2 As String
> Dim strPath As String, FldName As String
> Dim varRows As Variant
> Dim strFileName As String
> Dim rng As Excel.Range 'This is for calculating column "J "
> Dim astRow As Excel.Range 'This is for calculating the last row in
> column "J "
>
> Dim I As Integer, SheetCount As Integer
> Dim FileName As String, FirstSheet As String
>
> On Error GoTo Err_Handler
>
>
> Set DB = CurrentDb()
> '"SELECT Table1.Address FROM Table1 GROUP BY Table1.Address"
> SQL_2 = "SELECT PaymentCertificatetmp.ContractName FROM
> PaymentCertificatetmp GROUP BY PaymentCertificatetmp.ContractName"
> 'select the grouped contracts
> Set Rst_2 = DB.OpenRecordset(SQL_2)
>
> Dim strFilter As String
> SetStatus "Getting Data for Export ......Please Wait ....."
> 'this sets the windows open save filters to be excel
> strFilter = ahtAddFilterItem("Excel Files (*.xls)", "*.xls")
> 'This calls the windows open save window
> strsavefilename = ahtCommonFileOpenSave( _
> OpenFile:=False, _
> Filter:=strFilter, _
> Flags:=ahtOFN_OVERWRITEPROMPT Or ahtOFN_READONLY)
>
> SetStatus "Transferring Data to Spreadsheet ..... Please
> Wait ....."
>
>
> Me.logo.SetFocus 'this just goes to the logo field so that it can be
> copied
> DoCmd.RunCommand acCmdCopy 'this copies the logo into memory
> Me.cmbOrganisation.SetFocus
>
>
>
> FileName = strsavefilename
> strPath = strsavefilename
>
>
> 'This calls a save file api and works but it is not the standard windows
> open save api.
> 'FileName = InputBox("Enter the name of the file to be saved." & Chr(13)
> & Chr(13) & " The file will be saved in C:\Temp.")
> 'strPath = "c:\temp" & "\" & FileName & ".xls" 'same the file on the
> same path of the db.
>
>
>
> Set objExc = New Excel.Application
>
> If Len(FileName & "") > 0 Then 'Only run the file if the input
> box has a name of the file
> Set wkbk = objExc.Workbooks.add 'create a new workbook
>
> Do Until Rst_2.EOF
> FldName = Rst_2.Fields("ContractName")
> Set shts = wkbk.ActiveSheet
> wkbk.Sheets.add
> ' Add a new sheet to copy new data to
> SQL_1 = "SELECT ContractName as Contract,OrderNumber as [Order
> No],DepotName,EstimateNo,ExchArea,RateCode as NIMS,Description,Planned +
> DFE as Qty,Rate,Qty*Rate as Total FROM PaymentCertificatetmp WHERE
> ContractName = '" & FldName & "'" 'Fiter by each ContractName
> Set Rst_1 = DB.OpenRecordset(SQL_1)
>
> I = 1
> With Rst_1
> For Each Fld In .Fields 'place the field names in
> the excel A1 row.
> With shts '!!!!put all the custom changes here to go on
> all sheets!!!!!
> .Cells(1, 6).RowHeight = 62 ' this sets the row
> height for the log that will be pasted last as this area will paste the
> logo as many times as their are contracts otherwise
> .Cells(2, 1).Value = "Payment Certificate: "
> .Cells(2, 8).Value = "Week Ending: "
> .Cells(3, 1).Value = "Subcontractor: "
> .Cells(3, 8).Value = "Purchase Order: "
>
>
> .Cells(4, I) = Fld.Name 'this sets the row to put
> the column names eg(2,1) is row 2 column 1
> I = I + 1
> objExc.ActiveWindow.Zoom = 95
> End With
> Next
> End With
>
> 'this sets the column fonts
> to bold eg(4,1) = row 4 column 1
> Set Rge = shts.Rows("4:1") 'set the range to the
> fiRst_1 row in order to adjust the font and alignment
> Rge.Font.Bold = True ' Make the row bold
> Rge.HorizontalAlignment = xlCenter ' align to the center
>
>
> Set Rge = shts.Cells(5, 1) 'say where to start copying the
> data. eg (3,1) = row 3 column 1
> Rge.Font.Name = Ariel 'this sets the font name of the
> main data
> Rge.Font.Size = 8
> Rge.CopyFromRecordset Rst_1 ' Copy the Rst_1 into the
> worksheet
> Rst_1.Close ' close the recordset before
> calling it gain.
> Set Rst_1 = Nothing
>
> shts.Columns("A").ColumnWidth = 9.5
> shts.Columns("B").ColumnWidth = 12
> shts.Columns("C").ColumnWidth = 11
> shts.Columns("D").ColumnWidth = 12
> shts.Columns("E").ColumnWidth = 16
> shts.Columns("F").ColumnWidth = 4.83
> shts.Columns("G").ColumnWidth = 62.67
> shts.Columns("H").ColumnWidth = 11
> shts.Columns("I").ColumnWidth = 11
> shts.Columns("J").ColumnWidth = 11
> shts.Columns.HorizontalAlignment = xlCenter ' Align all the main
> data to center in each column
> 'shts.Columns.AutoFit ' make the columns autofit to
> fit the data
>
> Set Rge = shts.Rows.Cells(1, 7)
> Rge.PasteSpecial xlPasteAll 'this pastes the logo on after all
> other data so that it only pastes once into each workshee
>
> Set Rge = shts.Columns("I:J")
> Rge.NumberFormat = "$#,##0.00_);[Red]($#,##0.00)"
> *********************************************************
> *********** THIS IS WHERE I AM HAVING TROUBLE*******
> Set rng = shts.Range(Cells(4, "J"), Cells (Rows.Count,
> "J").End(xlUp))
> Set lastRow = rng(rng.Count).Offset(1, 0)
>
> 'TRYING TO PUT TOTAL AT END OF COLUMN JA
> **************************************************
> ******************************************************
>
> 'rge.Formula = sum(" & rge(
> 'Excel.Range("J" & cnt + 11).Formula = "=sum(J4:J" & cnt + 10 &
> ")"
>
>
> Set Rge = shts.Rows("2:1") 'Format the second row fonts and
> alignment left placed after all other alignment to center has been done
> or the other column alingments will overwrite these settings
> Rge.Font.Name = Ariel
> Rge.Font.Size = 12
> Rge.HorizontalAlignment = xlLeft
>
> Set Rge = shts.Rows("3:1") 'format the third row fonts and
> alignment
> Rge.Font.Name = Ariel
> Rge.Font.Size = 12
> Rge.HorizontalAlignment = xlLeft
>
>
> shts.Name = FldName 'Name each of the worksheet tabs
> with the contract name
>
>
> Rst_2.MoveNext
>
> Loop
> With wkbk
> FirstSheet = .Sheets(1).Name
> SheetCount = .Worksheets.Count
> .Sheets(FirstSheet).Move After:=.Sheets(SheetCount)
> .Sheets(1).Select
> End With
> wkbk.Close True, strPath 'Save the worksheets
> objExc.Quit 'Exit Excel
>
> End If
>
>
>
> Exit_Handler:
> 'clean up
> objExc.Quit
> Set objExc = Nothing
> Set wkbk = Nothing
> Set Rge = Nothing
> DB.Close
> Set DB = Nothing
> 'Exit Function
>
> Err_Handler:
> Select Case err.Number
> Case 1004 ' do nothing if the user does
> not decide to replace the file
> Resume Exit_Handler
> Case Else
> ' MsgBox err.Number & " " & err.Description
> End Select
>
> End Sub
>
>
>
>
>
>
> *** Sent via Developersdex http://www.developersdex.com ***
>

Hi DS,
Thank you so much for you quick reply.
I have tried the code In access 97 and Excel 2000 and I am getting a
compile error expected: =
If I put = in
Range("J65536").End (xlUp).Offset = (1,0)
I get compile error expected: )

Would you know what I am doing wrong.

Thank you.

Regards,

Sid



*** Sent via Developersdex http://www.developersdex.com ***

Hi DS,
this is just an update.
to get your formular working in access I am having to transpose it
something like this.

Excel.WorksheetFunction.Sum("J65536").End(xlUp).Offset(rowOffset:=1,
columnOffset:=0).Activate

but this still does not work.

regards,

Sid.



*** Sent via Developersdex http://www.developersdex.com ***

Hi Sid, in this instance, you need to drop the "=" you've inserted in the
Offset expression - i.e. "Offset(1,0)" rather than "Offset = (1,0)" as you've
put below.

Cheers
DS

"sid" wrote:

> Hi DS,
> Thank you so much for you quick reply.
> I have tried the code In access 97 and Excel 2000 and I am getting a
> compile error expected: =
> If I put = in
> Range("J65536").End (xlUp).Offset = (1,0)
> I get compile error expected: )
>
> Would you know what I am doing wrong.
>
> Thank you.
>
> Regards,
>
> Sid
>
>
>
> *** Sent via Developersdex http://www.developersdex.com ***
>

Hi Sid,

Afraid that one won't quite work there....

The code I posted previously will just identify the cell in which to place
the formula, it doesn't include the formula itself.

I'm not overly familiar with Access, so you'll need to "translate" this, but
the Excel VBA would look like:

Range("J65536").End(xlUp).Offset(1,0).Select
ActiveWorkbook.Names.Add "LastItem", RefersTo:=Selection.Offset(-1,0)
Selection.Formula = "=SUM(J2:LastItem)"
Selection.Copy
Selection.PasteSpecial Paste:=xlValues
ActiveWorkbook.Names("LastItem").Delete

This will select the cell in J requiring the total, populate it with the sum
of entries above it (assuming J1 is a header), fix that value, then delete
the cell reference used for the calculation.

Hope this helps
DS

"sid" wrote:

> Hi DS,
> this is just an update.
> to get your formular working in access I am having to transpose it
> something like this.
>
> Excel.WorksheetFunction.Sum("J65536").End(xlUp).Offset(rowOffset:=1,
> columnOffset:=0).Activate
>
> but this still does not work.
>
> regards,
>
> Sid.
>
>
>
> *** Sent via Developersdex http://www.developersdex.com ***
>

HI Ds,
thank you for your help this realy looks like what I am trying to do.

I have transposed the code for access prefixing Exel to point to my Exel
references. I have tried the code but I still cant get it to work.
But I think this will work if I can work out the transpositions.

I have run out of time today. But I will try it again on monday. It
cant be much to change.

This is my code now it accepts it in Access but does not do anything. I
have had some circular reference problems with it as well. J4 is the
header cell for column J.

Excel.Range("J65536").End(xlUp).Offset(1, 0).Select
Excel.ActiveWorkbook.Names.add "LastItem",
RefersTo:=Selection.Offset(-1, 0)
Excel.Selection.Formula = "=SUM(J4:LastItem)"
Excel.Selection.Copy
Excel.Selection.PasteSpecial Paste:=xlValues
Excel.ActiveWorkbook.Names("LastItem").Delete

Thank you.

regards,

Sid

*** Sent via Developersdex http://www.developersdex.com ***

I believe your problem can be corrected considering the following:

The RefersTo argument must be specified in A1-style notation, including
dollar signs ($) where appropriate. For example, if cell A10 is selected on
Sheet1 and you define a name by using the RefersTo argument "=sheet1!A1:B1",
the new name actually refers to cells A10:B10 (because you specified a
relative reference). To specify an absolute reference, use
"=sheet1!$A$1:$B$1".

So you may want to store the cell reference address where your last item
resides in a variable and then define the name by using the variable.
Once you have defined your name, you select the offsetting of that name by
one, placing the sum formula on that cell reference.

Hope this helps.



"sid" wrote:

>
> HI Ds,
> thank you for your help this realy looks like what I am trying to do.
>
> I have transposed the code for access prefixing Exel to point to my Exel
> references. I have tried the code but I still cant get it to work.
> But I think this will work if I can work out the transpositions.
>
> I have run out of time today. But I will try it again on monday. It
> cant be much to change.
>
> This is my code now it accepts it in Access but does not do anything. I
> have had some circular reference problems with it as well. J4 is the
> header cell for column J.
>
> Excel.Range("J65536").End(xlUp).Offset(1, 0).Select
> Excel.ActiveWorkbook.Names.add "LastItem",
> RefersTo:=Selection.Offset(-1, 0)
> Excel.Selection.Formula = "=SUM(J4:LastItem)"
> Excel.Selection.Copy
> Excel.Selection.PasteSpecial Paste:=xlValues
> Excel.ActiveWorkbook.Names("LastItem").Delete
>
> Thank you.
>
> regards,
>
> Sid
>
> *** Sent via Developersdex http://www.developersdex.com ***
>