If this is your first visit, be sure to check out the FAQ by clicking the link above. You may have to register before you can post: click the register link above to proceed. To start viewing messages, select the forum that you want to visit from the selection below.

 
Go Back  dBforums > PC based Database Applications > Microsoft Excel > sum rows

Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old
Registered User
 
Join Date: Nov 2012
Posts: 2
sum rows

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?
Reply With Quote
  #2 (permalink)  
Old
Registered User
 
Join Date: Jan 2002
Location: Bay Area
Posts: 507
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
Reply With Quote
  #3 (permalink)  
Old
Registered User
 
Join Date: Nov 2012
Posts: 2
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?
Reply With Quote
  #4 (permalink)  
Old
Registered User
 
Join Date: Jan 2002
Location: Bay Area
Posts: 507
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
Reply With Quote
Reply

Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On