Eric L
Eric L

Reputation: 13

Make Column Array dynamic

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

Answers (2)

QHarr
QHarr

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

warner_sc
warner_sc

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

Related Questions