Reputation: 13
I have the following code to run a sum formula at the bottom of specific columns based on a dynamic range of rows. My limitation is that i have to define which columns i wan this to happen to. How can i make it dynamic based on the last column with data in it?
Thanks
Option Explicit
Sub Sum()
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Master" And WS.Name <> "How to" And WS.Name <> "Template" Then
Dim CurCal As XlCalculation
Dim wb As Workbook, colsLastRow As Long
Dim cols As Variant, SumCols As Long, colsArray As Variant
Dim biggestRow As Long
Dim shNAMES As Range
Application.ScreenUpdating = False
CurCal = Application.Calculation
Application.Calculation = xlCalculationManual
biggestRow = 1
Set wb = ThisWorkbook
colsArray = Array("L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH", "AI", "AJ")
For Each cols In colsArray
colsLastRow = WS.Cells(Rows.Count, cols).End(xlUp).Row
If colsLastRow > biggestRow Then
biggestRow = colsLastRow + 1
End If
Next cols
For Each cols In colsArray
colsLastRow = WS.Cells(Rows.Count, cols).End(xlUp).Row
WS.Cells(biggestRow, cols).Formula = "=SUM(" & cols & "9:" & cols & colsLastRow & ")"
Next cols
WS.Range("B" & biggestRow).Value = "TOTAL"
WS.Cells(3, 3).Formula = "=LOOKUP(2,1/(N:N<>""""),N:N)"
Application.ScreenUpdating = True
Application.Calculation = CurCal
End If
Next WS
End Sub
Upvotes: 0
Views: 60
Reputation: 84465
Something like:
Ignoring sheets where not enough rows or columns
Option Explicit
Public Sub test()
Application.ScreenUpdating = False
Dim CurCal As Variant
CurCal = Application.Calculation
Application.Calculation = xlCalculationManual
Dim i As Long, ws As Worksheet, lastColumn As Long, lastRow As Long
Const startRow As Long = 9 '<=====change this to sum from a different row
Const startColumn As Long = 12 '<====change this for column to start putting totals at
For Each ws In ThisWorkbook.Worksheets
With ws
On Error Resume Next
lastColumn = GetLastColumn(ws)
lastRow = GetLastRow(ws)
If .Name <> "Master" And .Name <> "How to" And .Name <> "Template" Then
For i = 1 To lastColumn - startColumn + 1
.Cells(lastRow, i + startColumn - 1).Offset(1, 0).Formula = "=Sum(" & .Range(.Cells(startRow, i + startColumn - 1), .Cells(lastRow, i + startColumn - 1)).Address & ")"
Next i
If ws.UsedRange.Rows.Count > startRow - 1 And ws.UsedRange.Columns.Count > startColumn - 1 Then
ws.Range("B" & lastRow + 1) = "TOTAL"
ws.Cells(3, 3).Formula = "=LOOKUP(2,1/(N:N<>""""),N:N)"
End If
End If
On Error GoTo 0
End With
Next ws
Application.ScreenUpdating = True
Application.Calculation = CurCal
End Sub
Public Function GetLastColumn(ByVal ws As Worksheet) As Long
If Application.WorksheetFunction.Subtotal(103, ws.UsedRange) > 0 And ws.Cells.SpecialCells(xlCellTypeLastCell).Column > 11 Then
GetLastColumn = ws.Cells.SpecialCells(xlCellTypeLastCell).Column
End If
End Function
Public Function GetLastRow(ByVal ws As Worksheet) As Long
If Not Application.WorksheetFunction.Subtotal(103, ws.UsedRange) = 0 And ws.Cells.SpecialCells(xlCellTypeLastCell).Row > 8 Then
GetLastRow = ws.Cells.SpecialCells(xlCellTypeLastCell).Row
End If
End Function
Upvotes: 1
Reputation: 848
If your range is continuous you can find the first and last column like this:
Just adjust the rng
range to fit your table data range
Option Explicit
Sub test()
Dim first_col_letter As String
Dim first_col_number As Long
Dim last_col_letter As String
Dim last_col_number As Long
Dim rng As Range
Set rng = ActiveCell.CurrentRegion
With rng
first_col_letter = Chr(.Columns(1).Column + 64)
first_col_number = .Columns(1).Column
last_col_letter = Chr(.Columns(.Columns.Count).Column + 64)
last_col_number = .Columns(.Columns.Count).Column
End With
End Sub
Upvotes: 0