Consulting

Results 1 to 3 of 3

Thread: help with: suming only colour filled cells in a column

  1. #1

    help with: suming only colour filled cells in a column

    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

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    [vba]

    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
    [/vba]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    To add the formulae to the Total cell(s)
    [vba]
    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

    [/vba]
    Last edited by mdmackillop; 04-24-2009 at 07:56 AM. Reason: Code updated
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •