sum rows

079 · #1 (**permalink**) 11-29-12, 15:30

Hi, I am trying to set up a macro that will go down a column until the next empty row and then sum the rows above it. I have many columns therefore I need it do this to all the columns in my spreadsheet at once. Can anyone help?

JerryDal · #2 (**permalink**) 12-02-12, 18:30

Try this code.

Code:

Sub Add_Totals()
'Add totals to columns with at least 1 data row
'Stops when 1st row in a column does not have a heading
'Limit: 256 columns
Dim lastRow As Long, firstDataRow As Long
Dim currColumn As Integer, lastColumn As Integer
Dim columnChar As String

    Application.ScreenUpdating = False
    
    firstDataRow = 2        'edit this to be the starting row number of the data
    
    For lastColumn = 0 To 255
        If Trim(Cells(1, lastColumn + 1).Value) <> "" Then
            lastColumn = lastColumn + 1
        Else
            Exit For
        End If
    Next
    
    For currColumn = 1 To lastColumn
        Cells(1, currColumn).Select

        columnChar = _
            Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - InStr(1, ActiveCell.Address, "$") - 1)
        
        lastRow = Range(columnChar & "65536").End(xlUp).Row
        If lastRow >= firstDataRow Then _
            Cells((lastRow + 1), currColumn).Formula = _
                "=SUM(" & columnChar & "2:" & columnChar & lastRow & ")"
    Next
    
    Application.ScreenUpdating = True
    
End Sub

079 · #3 (**permalink**) 12-06-12, 07:53

Great thank you! Now I just need these cells to have a black background, white font and be in currency format (ie 2d.p. and commas between the thousands). any ideas?

JerryDal · #4 (**permalink**) 12-06-12, 15:01

You can start the macro recorder, then add all the formatting to one of the cells. End recording and copy the recorded code,
which will be in a module, into the worksheet module, just below the code that assigns a formula to a cell, then edit the
code for workability and conciseness.
To save you time and frustration, I've done this in the code below.

Code:

Sub Add_Totals()
'Add totals to columns with at least 1 data row with currency formatting,
'and white font over black background
'Stops when 1st row in a column does not have a heading
'Limit: 256 columns
Dim lastRow As Long, firstDataRow As Long
Dim currColumn As Integer, lastColumn As Integer
Dim columnChar As String

    Application.ScreenUpdating = False
    
    firstDataRow = 2        'edit this to be the starting row number of the data
    
    For lastColumn = 0 To 255
        If Trim(Cells(1, lastColumn + 1).Value) <> "" Then
            lastColumn = lastColumn + 1
        Else
            Exit For
        End If
    Next
    
    For currColumn = 1 To lastColumn
        Cells(1, currColumn).Select

        columnChar = _
            Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$") - InStr(1, ActiveCell.Address, "$") - 1)
        
        lastRow = Range(columnChar & "65536").End(xlUp).Row
        If lastRow >= firstDataRow Then
            Cells((lastRow + 1), currColumn).Select
            
            With Selection
                .Formula = _
                    "=SUM(" & columnChar & "2:" & columnChar & lastRow & ")"
                .NumberFormat = "$#,##0.00"
                .Font.ColorIndex = 2
            End With
            
            With Selection.Interior
                .ColorIndex = 1
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
            End With
            
        End If
    Next
    
    Application.ScreenUpdating = True
    
End Sub

Internet Services

Web Development

Digital Marketing

Consumer Tech