PDA

View Full Version : help with: suming only colour filled cells in a column



ThePigeon
04-24-2009, 06:47 AM
Hey there
Sorry to be back asking dreadfully simple questions…
Just to explain further on the title:
I’ve got a column of numerical data with certain rows highlighted with a yellow fill to show they are used in the total, what I want to create is a code that automatically recognises cell formatted with a yellow fill within the range and makes them the only values added to create the total.

I’m a bit lost on where to start so if someone could help me with a framework code or direct me to a good tutorial that would be much appreciated.
Thanks in advance for any help,
Regards,
Joe

Bob Phillips
04-24-2009, 07:11 AM
Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim i As Long
Dim LastRow As Long
Dim tmp As Double

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

If .Cells(i, TEST_COLUMN).Interior.ColorIndex = 6 Then

tmp = tmp + .Cells(i, TEST_COLUMN).Value
End If
Next i

.Cells(LastRow + 1, TEST_COLUMN).Value = tmp
End With

End Sub

mdmackillop
04-24-2009, 07:14 AM
To add the formulae to the Total cell(s)

Sub AddColour()
Dim Cel As Range
Dim Colour As Long
Dim Stops As Long
Dim CellAdd As String
Dim CurCell As Range
Dim i As Long
Application.ScreenUpdating = False
Stops = 3 'Stops if red cell is found or
'Get colour of target cell to be totalled.
For Each Cel In Selection
i = 0
Set CurCell = Nothing
Colour = Cel.Interior.ColorIndex
'Check each cell above target cell and add to range if true
Do Until Cel.offset(-i).row() = 1 Or Cel.offset(-i, 0).Interior.ColorIndex = Stops
i = i + 1
If Cel.offset(-i, 0).Interior.ColorIndex = Colour Then
If CurCell Is Nothing Then
Set CurCell = Cel.offset(-i, 0)
Else
Set CurCell = Union(CurCell, Cel.offset(-i, 0))
End If
End If
Loop
Cel.Formula = "=SUM(" & CurCell.address(0, 0) & ")"
Next
Application.ScreenUpdating = True
End Sub