Get last column

J

Jeremy

Dear All

First of all I'm not a VB developer and have only limited knowledge of
Excel. To make it worse I work with Lotus Notes. Having said that I hope
someone can help me with what I would think is a simple problem.

We have a Notes database from which I want to export certain data to Excel.
This data is training information consisting of a course title (string) and
the hours (integer) completed.

The export code (see below) works fine. However I need to add a formula to
sum the hours in the last column of the sheet. The number of columns varies
depending on the sheet in question so I need to append the @Sum function
dynamically but am not sure how. I think I have to use the Offset property
but am not sure how to apply it.

Can anyone help?

Sub Click(Source As Button)

Dim session As New NotesSession
Dim thisdb As NotesDatabase
Dim docProfile As NotesDocument
Dim view As NotesView
Dim fieldName As String
Dim courseItem As NotesItem
Dim fixedHeaders(0 To 2) As String
Dim columnHeaders As New Array
Dim col As Integer, Exported As Integer, i As Integer
Dim strFormula As String
Dim rowNumber As Single
Dim colNumber As Single
Dim strAddress As String, strColumn As String

fixedHeaders(0) = "Source"
fixedHeaders(1) = "Role"
fixedHeaders(2) = "Task"

Call columnHeaders.Initialize(fixedHeaders)

Set thisdb = Session.CurrentDatabase
Set docProfile = thisdb.GetProfileDocument("Setup")

Dim ViewList List As String
ViewList("Export01")="US GAAS"
ViewList("Export02")="US GAAP"
ViewList("Export03")="ISA"
ViewList("Export04")="IFRS"
ViewList("Export05")="AIR"
ViewList("Export06")="Other"

Dim index As Integer
Dim wsName As String
Dim ViewName As String

Dim doc As NotesDocument
Dim xlapp As Variant
Dim xlsheet As Variant
Set xlapp=CreateObject("Excel.Application")
xlapp.Visible=True
xlapp.Workbooks.Add
xlapp.Sheets.Add
xlapp.Sheets.Add
xlapp.Sheets.Add

Forall vw In ViewList
index=index+1
wsName=vw
ViewName=Listtag(vw)

Set courseItem = docProfile.GetFirstItem("Course00" + Cstr(index))

Forall v In courseItem.Values
Call columnHeaders.AppendNewValue(Strtoken(v, "~", 1))
End Forall

Set view = thisdb.GetView(ViewName)

Set xlsheet = xlapp.Workbooks(1).Worksheets(index)
xlsheet.Name = wsName

'Add the column titles to the Excel document
i = 0
Forall c In columnHeaders.Array
i = i + 1
xlsheet.Cells(1,i).Value= c
If i < 4 Then 'Format excel document
xlsheet.Cells(1,i).Interior.ColorIndex = 15
xlsheet.Cells(1,i).Font.Name = "Arial"
xlsheet.Cells(1,i).Font.Size = 10
xlsheet.Cells(1,i).Font.FontStyle = "Vet"
xlsheet.Cells(1,i).Borders.LineStyle = True
xlsheet.Cells(1,i).WrapText = True
xlsheet.Cells(1,i).HorizontalAlignment = 3
xlsheet.Columns("A:A").ColumnWidth = 20
xlsheet.Columns("B:B").ColumnWidth = 20
xlsheet.Columns("C:C").ColumnWidth = 20
Else
xlsheet.Cells(1,i).Interior.ColorIndex = 35
xlsheet.Cells(1,i).Font.Name = "Arial"
xlsheet.Cells(1,i).Font.Size = 9
xlsheet.Cells(1,i).Font.FontStyle = "Vet"
xlsheet.Cells(1,i).Orientation = 90
xlsheet.Cells(1,i).Borders.LineStyle = True
xlsheet.Cells(1,i).WrapText = True
xlsheet.Cells(1,i).RowHeight = 150
End If
End Forall

Dim row As Integer
row=1

Dim vc As NotesViewEntryCollection
Set vc=view.AllEntries

Dim ve As NotesViewEntry
Set ve=vc.GetFirstEntry
While Not (ve Is Nothing)
row=row+1
col%=0

Forall colval In ve.ColumnValues
col% = col% + 1
xlsheet.Cells(row,col%).Value=colval
xlsheet.Cells(row,col%).Borders.LineStyle = True
strAddress = xlsheet.Cells(row,col%).Address
End Forall
'Add the total formula to the last column in the sheet.
strColumn = Strtoken(strAddress, "$", 2)
'xlsheet.Cells(row,col%).Offset(rowOffset:=3).Activate = "1"
'xlsheet.Cells(row,col%).Offset(1, 0)

Exported=Exported+1
Print wsName + " - "+"exported: " + Cstr(Exported)
Set ve=vc.GetNextEntry(ve)
Wend
'Re- initials the columnHeaders to the basics ( Source, Role and Task)
Call columnHeaders.Initialize(fixedHeaders)

' Call ExportToExcel(ViewName,xlapp,index,wsName)
End Forall
End Sub

Thanks

Jeremy
 
B

Bob Phillips

I haven't looked through all your code, but you can get the last column in
say row 2 like this

LastCol = Cells(2, Columns.Count).End(xlToLeft).Column

then add a formula to sum column 2 to that column like so

Cells(2, LastCol + 1).FormulaR1C1 = "=SUM(RC2:RC[-1])"

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)
 
J

Jeremy

Great stuff. Thank you very much.

Jeremy



Bob Phillips said:
I haven't looked through all your code, but you can get the last column in
say row 2 like this

LastCol = Cells(2, Columns.Count).End(xlToLeft).Column

then add a formula to sum column 2 to that column like so

Cells(2, LastCol + 1).FormulaR1C1 = "=SUM(RC2:RC[-1])"

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

Jeremy said:
Dear All

First of all I'm not a VB developer and have only limited knowledge of
Excel. To make it worse I work with Lotus Notes. Having said that I hope
someone can help me with what I would think is a simple problem.

We have a Notes database from which I want to export certain data to
Excel.
This data is training information consisting of a course title (string)
and
the hours (integer) completed.

The export code (see below) works fine. However I need to add a formula
to
sum the hours in the last column of the sheet. The number of columns
varies
depending on the sheet in question so I need to append the @Sum function
dynamically but am not sure how. I think I have to use the Offset
property
but am not sure how to apply it.

Can anyone help?

Sub Click(Source As Button)

Dim session As New NotesSession
Dim thisdb As NotesDatabase
Dim docProfile As NotesDocument
Dim view As NotesView
Dim fieldName As String
Dim courseItem As NotesItem
Dim fixedHeaders(0 To 2) As String
Dim columnHeaders As New Array
Dim col As Integer, Exported As Integer, i As Integer
Dim strFormula As String
Dim rowNumber As Single
Dim colNumber As Single
Dim strAddress As String, strColumn As String

fixedHeaders(0) = "Source"
fixedHeaders(1) = "Role"
fixedHeaders(2) = "Task"

Call columnHeaders.Initialize(fixedHeaders)

Set thisdb = Session.CurrentDatabase
Set docProfile = thisdb.GetProfileDocument("Setup")

Dim ViewList List As String
ViewList("Export01")="US GAAS"
ViewList("Export02")="US GAAP"
ViewList("Export03")="ISA"
ViewList("Export04")="IFRS"
ViewList("Export05")="AIR"
ViewList("Export06")="Other"

Dim index As Integer
Dim wsName As String
Dim ViewName As String

Dim doc As NotesDocument
Dim xlapp As Variant
Dim xlsheet As Variant
Set xlapp=CreateObject("Excel.Application")
xlapp.Visible=True
xlapp.Workbooks.Add
xlapp.Sheets.Add
xlapp.Sheets.Add
xlapp.Sheets.Add

Forall vw In ViewList
index=index+1
wsName=vw
ViewName=Listtag(vw)

Set courseItem = docProfile.GetFirstItem("Course00" + Cstr(index))

Forall v In courseItem.Values
Call columnHeaders.AppendNewValue(Strtoken(v, "~", 1))
End Forall

Set view = thisdb.GetView(ViewName)

Set xlsheet = xlapp.Workbooks(1).Worksheets(index)
xlsheet.Name = wsName

'Add the column titles to the Excel document
i = 0
Forall c In columnHeaders.Array
i = i + 1
xlsheet.Cells(1,i).Value= c
If i < 4 Then 'Format excel document
xlsheet.Cells(1,i).Interior.ColorIndex = 15
xlsheet.Cells(1,i).Font.Name = "Arial"
xlsheet.Cells(1,i).Font.Size = 10
xlsheet.Cells(1,i).Font.FontStyle = "Vet"
xlsheet.Cells(1,i).Borders.LineStyle = True
xlsheet.Cells(1,i).WrapText = True
xlsheet.Cells(1,i).HorizontalAlignment = 3
xlsheet.Columns("A:A").ColumnWidth = 20
xlsheet.Columns("B:B").ColumnWidth = 20
xlsheet.Columns("C:C").ColumnWidth = 20
Else
xlsheet.Cells(1,i).Interior.ColorIndex = 35
xlsheet.Cells(1,i).Font.Name = "Arial"
xlsheet.Cells(1,i).Font.Size = 9
xlsheet.Cells(1,i).Font.FontStyle = "Vet"
xlsheet.Cells(1,i).Orientation = 90
xlsheet.Cells(1,i).Borders.LineStyle = True
xlsheet.Cells(1,i).WrapText = True
xlsheet.Cells(1,i).RowHeight = 150
End If
End Forall

Dim row As Integer
row=1

Dim vc As NotesViewEntryCollection
Set vc=view.AllEntries

Dim ve As NotesViewEntry
Set ve=vc.GetFirstEntry
While Not (ve Is Nothing)
row=row+1
col%=0

Forall colval In ve.ColumnValues
col% = col% + 1
xlsheet.Cells(row,col%).Value=colval
xlsheet.Cells(row,col%).Borders.LineStyle = True
strAddress = xlsheet.Cells(row,col%).Address
End Forall
'Add the total formula to the last column in the sheet.
strColumn = Strtoken(strAddress, "$", 2)
'xlsheet.Cells(row,col%).Offset(rowOffset:=3).Activate = "1"
'xlsheet.Cells(row,col%).Offset(1, 0)

Exported=Exported+1
Print wsName + " - "+"exported: " + Cstr(Exported)
Set ve=vc.GetNextEntry(ve)
Wend
'Re- initials the columnHeaders to the basics ( Source, Role and Task)
Call columnHeaders.Initialize(fixedHeaders)

' Call ExportToExcel(ViewName,xlapp,index,wsName)
End Forall
End Sub

Thanks

Jeremy
Click to expand...
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Working outlook via vba code with xlsx - error 0
Help needed! Extracting Heading 3 and Contents from a Word Doc to Excel 0
How to merge columns from excel and how to set customize each columns 0
Range Delete Not working completely 5
VBA Export to PDF 0
trying to use PasteAndFormat method in Excel VBA is not working 0
Word macro that can call cells out of Excel for a find and replace 0
Macro Expert's 1

Top