Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Westi on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

VBA code to sum cells in a column

Status
Not open for further replies.
end922

end922

Technical User
Apr 17, 2007
59
US
Greetings,

I have put together a macro (recorded) that preforms a count in a column. The macro works great if the numbers of rows do not change or the number increases however, if the number of rows shrinks by 1 then it doesn't work.
Do you have any suggestions on how I can fix this?


Thanks
Eric

Code: 
        'Grey
    ActiveCell.FormulaR1C1 = "=cgrey(R[-52]C:R[-1]C)"
        With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    ActiveCell.Offset(1, 0).Activate
 
Sort by date Sort by votes
send your entire code

This old world keeps spinning round - It's a wonder tall trees ain't layin' down
 
Upvote 0 Downvote


Eric,

Why are you using VBA to perform something that can be accomplished perfectly well with a spreadsheet function?

Regarding the range changing, there are a number of ways to address.
[tt]
1. make the range from the FIRST row to the very last row on the sheet, 65,536.

2, Use a Dynamic Named Range. SkipVought
[/tt]


Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Guys, understand I'm a newbie, I know enough to be dangerious.

White605
the first part "Pick up calcs from each milestone" preps each spreadsheet for the count description...Completed, On Target...
The second part, "Begin color count" is where I have problems when the number of projects decrease and they will decrease as they complete there final milstone.

Skip, for #1 I think if I do my range between top and bottom then I will get a circular reference error in my formula.

for # 2 I played with it but don't know what I am doing to define a named range for each column in the 13 spreadsheets.
There would be approx 43 columns in all.

is there a tag to post a screen shot?

Thanks Eric


Code: 
' pick up calcs from each milestone

Dim A As Integer
    Dim B As Integer
    

    For A = 1 To 12
    
    Range("A1").Select
    Selection.End(xlDown).Offset(1, 0).Select
    ActiveCell.FormulaR1C1 = "Completed"
           With Selection.Interior
        .ColorIndex = 15
        .Pattern = xlSolid
    End With
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    Selection.Offset(1, 0).Activate
    
    ' on target
    
    ActiveCell.FormulaR1C1 = "On Target"
      With Selection.Interior
        .ColorIndex = 4
        .Pattern = xlSolid
    End With
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    Selection.Offset(1, 0).Activate
    
    ' Close to late
    
    ActiveCell.FormulaR1C1 = "Close to Late"
     With Selection.Interior
        .ColorIndex = 6
        .Pattern = xlSolid
    End With
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    Selection.Offset(1, 0).Activate
    
    ' Late
    
    ActiveCell.FormulaR1C1 = "Late"
    With Selection.Interior
        .ColorIndex = 3
        .Pattern = xlSolid
    End With
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    Selection.Offset(1, 0).Activate
        
    'Open Milestones
    
    ActiveCell.FormulaR1C1 = "Open Milestones"
    With Selection
        .HorizontalAlignment = xlRight
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    Selection.Offset(1, 0).Activate
        
   'Avg Open Milestones
    
    ActiveCell.FormulaR1C1 = "Avg Open Milestones"
    With Selection
       .HorizontalAlignment = xlRight
       .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    Selection.Offset(-5, 1).Activate
   
' Begin ColorCount
        'Grey
    ActiveCell.FormulaR1C1 = "=cgrey(R[-37]C:R[-1]C)"
         With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    ActiveCell.Offset(1, 0).Activate
'Green
    ActiveCell.FormulaR1C1 = "=cgreen(R[-38]C:R[-2]C)"
       With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    ActiveCell.Offset(1, 0).Activate
'Yellow
     ActiveCell.FormulaR1C1 = "=cyellow(R[-39]C:R[-3]C)"
      With Selection
      .HorizontalAlignment = xlCenter
      .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    ActiveCell.Offset(1, 0).Activate
'Red
    ActiveCell.FormulaR1C1 = "=cred(R[-40]C:R[-4]C)"
       With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Selection.Font.Bold = True
    ActiveCell.Offset(-3, 0).Activate

    Range(Selection, Selection.End(xlDown)).Copy
    
    'ActiveCell.Offset(0, 1).Activate
    
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

    Selection.Resize(Selection.Rows.Count - 2, _
    Selection.Columns.Count).Select
    
    ActiveSheet.Paste

    
    'Do sum for open milestone
    
    ActiveCell.Offset(4, 0).Activate
    
    ActiveCell.FormulaR1C1 = "=if(SUM(R[-3]C:R[-1]C)=0,"""",SUM(R[-3]C:R[-1]C))"
        'ActiveCell.FormulaR1C1 = "=SUM(R[-3]C:R[-1]C)"
    Selection.Copy
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.Resize(Selection.Rows.Count - 1, _
    Selection.Columns.Count).Select
    ActiveSheet.Paste
    Selection.Font.Bold = True
    With Selection
       .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    
    ActiveCell.Offset(1, 0).Activate
    
   'paste special all formulas
       
        Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("C1").Select
    Selection.End(xlDown).Select
    
    'for deletion of extra cells
    
    Range("A4").Activate
    Selection.End(xlToRight).Offset(0, 1).Activate
    'Selection.End(xlToRight).Offset(0, 1).Activate
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.EntireColumn.Delete
    Range("A2").Activate
    Selection.End(xlDown).Offset(0, 1).Select
    
      'average
    
        ActiveCell.FormulaR1C1 = "=if(sum(R[-1]C:R[-1]C[33])<1,0,average(R[-1]C:R[-1]C[33]))"
        'ActiveCell.FormulaR1C1 = "=AVERAGE(R[-1]C:R[-1]C[33])"
        Selection.Font.Bold = True
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    End With
    Selection.NumberFormat = "0"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False

   'Commets
    Range("A4").Activate
    Selection.End(xlToRight).Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "Comments"
    Selection.Font.Bold = True
    With Selection.Font
        .Name = "Tahoma"
        .Size = 10
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
    
    End With
       Cells.Select
    Selection.ColumnWidth = 88
    Cells.EntireColumn.AutoFit
    Cells.EntireRow.AutoFit
    Range("A1").Select
    ActiveWindow.SmallScroll ToRight:=-7
    ActiveSheet.Next.Select
      
    Next A
 
Upvote 0 Downvote
Don't put your sum at the bottom of the column. That is leftover from the days of paper, and, in today's world, it forces the recipient to scroll around looking for the totals.

Instead, put your sums at the top. Freeze Panes, and the sum will always be visible, even when the user scrolls through data.

Let's say your totals row is in row 2 and your data starts in row 4. You can do
[tab]=sum(A4:A65536)

(Note - excel 2003 has 65,536 rows available, excel 2007 has 1,048,576 rows available)

[tt][blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ 181-2886 before posting.
 
Upvote 0 Downvote
Thank you, interesting solution I will have to see how it looks. They may like it or hate it.
But I am faced with a challenge and need to learn this stuff.
 
Upvote 0 Downvote



It makes life so much easier for you and your users, when aggregations are at the top of the sheet, as John has suggested. I do this almost all the time on summary reports.

If you must have SUBTOTALS interspersed in the table, use the Excel Subtotal feature in Data > Subtotals... or use the SUBTOTAL spreadsheet function, which, btw, is not restricted to sum aggregations.

I Fear that you are making your application much more complicated than it needs to be.

Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
understood. my counts are counting colors. Is there a way to make my functions... =cgrey()....=cred()... appear in DATA>Subtotals?
 
Upvote 0 Downvote



Then your question should have been...

VBA code to sum COLORS in a column
/b]


Skip,
[glasses]Don't let the Diatribe...
talk you to death![tongue]
[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

IcarusHallsorts
  • Locked
  • Question
I have a column of data in Column A
Replies
3
Views
376
Andrzejek
Andrzejek
Andrzejek
  • Locked
  • Question
Outlook VBA - Trust access
Replies
3
Views
809
hermanlaksko
hermanlaksko
thanhthanh12
  • Locked
  • Question
Help vba
Replies
3
Views
513
combo
combo
xwb
  • Locked
  • Helpful tip
Performing VBA operations in other languages
Replies
1
Views
404
strongm
strongm
sal21
  • Locked
  • Question
scrping in listbox in a web page
Replies
0
Views
468
sal21
sal21

Part and Inventory Search

Sponsor

Back
Top