Totals at the bottom

[Guest]

Hi All,

I have a large number of spreadsheets, each one has a different number of
columns, the first two columns are always the same, but the number of columns
following changes as does the number of rows.

I want to be able to be able to use VBA to add a totals (from Cell 2 in that
column to the last cell in that column) row to the bottom of the data but i
want it to be able to do this for all the columns that contain data except
the first two which contain text, where the number of columns and rows
changes with each spreadsheet.

I also want to add a border around each cell in this totals line, colour
them in grey and make them bold, i also want to merge the cells in columns
A&B at this total line, enter the word 'Totals', left align and use the same
formatting that i have just mentioned.

Thanks for any help you can give!
Emma

 

[Guest]

Sub AddTotals()
Dim lastrow As Long, col As Long
Dim rng As Range, cell As Range
lastrow = Cells(Rows.Count, 1).End(xlUp).Row + 1
col = Cells(2, Columns.Count).End(xlToLeft).Column
Set rng = Range(Cells(lastrow, 3), Cells(lastrow, col))
rng.FormulaR1C1 = "=Sum(R[-1]C:R2C)"
rng.Interior.ColorIndex = 15
rng.Font.Bold = True
For Each cell In rng
cell.BorderAround Weight:=xlMedium
Next
With Cells(lastrow, 1).Resize(1, 2)
.Merge
.HorizontalAlignment = xlLeft
.BorderAround Weight:=xlMedium
.Interior.ColorIndex = 15
.Font.Bold = True
End With
Cells(lastrow, 1).Value = "Totals"

End Sub

 

[Guest]

Emma

Try this it will do all the worksheets in the activeworkbook.

Option Explicit
Const firstrow As Integer = 2

Sub formatcell(c As Range)
c.Borders.LineStyle = xlContinuous
c.Borders.Weight = xlMedium
c.Font.Bold = True
c.Interior.ColorIndex = 15
End Sub
Sub addtotals()
Dim ws As Worksheet
Dim lrow As Long
Dim lcol As Long

For Each ws In ActiveWorkbook.Worksheets
If ws.Cells(Cells.columns.Count, 1) = "" Then
lrow = ws.Cells(ws.Cells.columns.Count, 1).End(xlUp).Row
If lrow <> 1 Or ws.Cells(1, 1) <> "" Then
lrow = lrow + 1
Range(ws.Cells(lrow, 1), ws.Cells(lrow, 2)).Merge
ws.Cells(lrow, 1) = "Total"
formatcell ws.Range(ws.Cells(lrow, 1), ws.Cells(lrow, 2))
lcol = 3
Do While ws.Cells(1, lcol) <> "" ' check if header may need to
modify
ws.Cells(lrow, lcol).Formula = _
"=sum(R" & firstrow & "C" & lcol & ":R" & lrow - 1 & "C"
& lcol & ")"
formatcell (ws.Cells(lrow, lcol))
lcol = lcol + 1
Loop
End If
End If
Next ws
End Sub