Loading
Ozgrid Excel Help & Best Practices Forums

Excel Training / Excel Dashboards Reports



Results 1 to 7 of 7

Thread: Subtotal By Cell Color

  1. #1
    Join Date
    6th January 2006
    Posts
    20

    Subtotal By Cell Color

    Count Sum By Color. I have an enormous sheet of 6000+ records. I have a macro running that permits automatic counting of cells according to their background colour. What I would like to be able to do when selecting some records is for the colour count to recognize this, and not continue to count the hidden data. Subtotal works fine regarding the displayed records, but can it be used in conjunction with the colorfunction macro so as to only count the selected record colours where applicable. I would also like to be able to sort according to the background colour, but without adding another column. Are there any boffins out there who can help???????? Please, coz it's driving me nuts!!

    Code:
    Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
        Dim rCell As Range
        Dim lCol As Long
        Dim vResult
    
     
        lCol = rColor.Interior.ColorIndex
    
        If SUM = True Then
            For Each rCell In rRange
                If rCell.Interior.ColorIndex = lCol Then
                    vResult = WorksheetFunction.SUM(rCell, vResult)
                End If
            Next rCell
        Else
            For Each rCell In rRange
                If rCell.Interior.ColorIndex = lCol Then
                    vResult = 1 + vResult
                End If
            Next rCell
        End If
    
       ColorFunction = vResult
    End Function
    Cell formula =colorfunction($H$10,$A:$A,FALSE) - counts colours
    =subtotal(3,B12:B6000)
    Last edited by Dave Hawley; December 3rd, 2006 at 12:44. Reason: add code tags, please use when posting codes

    Excel Video Tutorials / Excel Dashboards Reports


  2. #2
    Join Date
    2nd November 2005
    Location
    Wessex
    Posts
    1,267

    Re: Subtotalling cell colours

    This is an example of where you are getting the VBA to do much IMO, whereas you can make Excel do the work for you.

    My approach is to have a simple Custom Function like the ColorIndex function that is passed a range, and which passes back an array of colorindex numbers. This array can then be passed to the SUMPRODUCT function to do the counting for you. This flexibility allows counting, summing or whatever, as you will see.

    My function is

    [vba]
    '---------------------------------------------------------------------
    Function ColorIndex(rng As Range, _
    Optional text As Boolean = False) As Variant
    '---------------------------------------------------------------------
    Dim cell As Range, row As Range
    Dim i As Long, j As Long
    Dim iWhite As Long, iBlack As Long
    Dim aryColours As Variant

    If rng.Areas.Count > 1 Then
    ColorIndex = CVErr(xlErrValue)
    Exit Function
    End If

    If rng.Cells.Count = 1 Then
    If text Then
    aryColours = rng.Font.ColorIndex
    Else
    aryColours = rng.Interior.ColorIndex
    End If
    Else
    aryColours = rng.Value
    i = 0
    For Each row In rng.Rows
    i = i + 1
    j = 0
    For Each cell In row.Cells
    j = j + 1
    If text Then
    aryColours(i, j) = cell.Font.ColorIndex
    Else
    aryColours(i, j) = cell.Interior.ColorIndex
    End If
    Next cell
    Next row
    End If

    ColorIndex = aryColours

    End Function
    [/vba]

    and I would use it in a worksheet like so

    Code:
    =SUMPRODUCT(--(ColorIndex(A1:A20)=3)
    or

    Code:
    =SUMPRODUCT(--(ColorIndex(A1:A20)=ColorIndex(A1))
    The beauty about this is that in your case we can incorporate the hidden cells in the formulam using SUBTOTAL, such as

    Code:
    =SUMPRODUCT((SUBTOTAL(3,OFFSET(A1,ROW(A1:A20)-MIN(ROW(A1:A20)),,1))),--((ColorIndex(A1:A20)=3)))
    which counts all cells that are red, but are not hidden.
    Last edited by Dave Hawley; December 3rd, 2006 at 12:45.
    HTH

    Bob

  3. #3
    Join Date
    6th January 2006
    Posts
    20

    Re: Subtotalling cell colours

    Thanks Bob, will give it a go tomorrow.

    Steve

    Excel Video Tutorials / Excel Dashboards Reports


  4. #4
    Join Date
    2nd November 2005
    Location
    Wessex
    Posts
    1,267

    Re: Subtotalling cell colours

    Let us know how it goes.
    HTH

    Bob

  5. #5
    Join Date
    6th January 2006
    Posts
    20

    Re: Subtotalling cell colors

    Bob,

    Thanks very much, code worked a treat, but have a couple more questions.

    1. I use the code ### =SUM(IF(B12:B5989="ej7",IF(LEFT(J12:J5989,3)="4GS",1,0))) #### to sum values that begin in this case with "4GS" and =ej7. As with the previous request I would also like to subtotal these values to count only the the filtered records.
    2. In addition to this I would also like to select the cell next to the one displaying the count values (Displays the count identifier) and perform a sort. I have been trying to use this..........

    Code:
     Private Sub Worksheet_SelectionChange(ByVal Target As Range)
      Application.ScreenUpdating = False
      'GoTo bottom
      cell = ActiveCell.Address
        If cell = ("$C$16") Then GoTo Line5
        If cell = ("$D$16") Then GoTo Line10
        If cell = ("$E$16") Then GoTo Line15
        If cell = ("$F$16") Then GoTo Line20
        If cell = ("$G$16") Then GoTo Line25
        If cell = ("$H$16") Then GoTo Line30
        If cell = ("$I$16") Then GoTo Line35
        If cell = ("$J$16") Then GoTo Line40
        If cell = ("$K$16") Then GoTo Line45
        If cell = ("$L$16") Then GoTo Line50
        If cell = ("$M$16") Then GoTo Line55
        If cell = ("$N$16") Then GoTo Line60
        If cell = ("$O$16") Then GoTo Line65
        If cell = ("$P$16") Then GoTo Line70
        If cell = ("$C$7") Then GoTo Line75
        If cell = ("$D$7") Then GoTo Line80
        If cell = ("$E$7") Then GoTo Line85
        If cell = ("$F$7") Then GoTo Line90
        If cell = ("$G$7") Then GoTo Line95
        If cell = ("$H$7") Then GoTo Line100
        If cell = ("$I$7") Then GoTo Line105
        If cell = ("$K$7") Then GoTo Line110
        If cell = ("$L$7") Then GoTo Line115
        If cell = ("$M$7") Then GoTo Line120
        If cell = ("$N$7") Then GoTo Line125
        If cell = ("$O$7") Then GoTo Line130
        If cell = ("$P$7") Then GoTo Line135
        If cell = ("$C$10") Then GoTo Line140
        If cell = ("$D$10") Then GoTo Line145
        If cell = ("$E$10") Then GoTo Line150
        If cell = ("$F$10") Then GoTo Line155
        If cell = ("$G$10") Then GoTo Line160
        If cell = ("$H$10") Then GoTo Line165
        If cell = ("$I$10") Then GoTo Line170
        If cell = ("$J$10") Then GoTo Line175
        If cell = ("$K$10") Then GoTo Line180
        If cell = ("$L$10") Then GoTo Line185
        If cell = ("$M$10") Then GoTo Line190
        If cell = ("$N$10") Then GoTo Line195
        If cell = ("$O$10") Then GoTo Line200
        If cell = ("$N$13") Then GoTo Line205
        If cell = ("$O$13") Then GoTo Line210
        If cell = ("$P$13") Then GoTo Line215
        If cell = ("$Q$13") Then GoTo Line220
        If cell = ("$R$13") Then GoTo Line225
        If cell = ("$S$13") Then GoTo Line230
        If cell = ("$R$15") Then GoTo Line235
        If cell = ("$S$15") Then GoTo Line240
        If cell = ("$C$13") Then GoTo Line245
        If cell = ("$D$13") Then GoTo Line250
        If cell = ("$E$13") Then GoTo Line255
        If cell = ("$F$13") Then GoTo Line260
        If cell = ("$G$13") Then GoTo Line265
        If cell = ("$H$13") Then GoTo line270
        If cell = ("$I$13") Then GoTo Line275
        If cell = ("$J$13") Then GoTo Line280
        If cell = ("$K$13") Then GoTo Line285
        
        
        
        If cell = ("$A$15") Then GoTo Line900
        If cell = ("$A$6") Then GoTo Line900
        If cell = ("$J$6") Then GoTo Line900
        If cell = ("$A$9") Then GoTo Line900
        If cell = ("$A$12") Then GoTo Line900
        If cell = ("$L$12") Then GoTo Line900
        
        
    GoTo bottom
    Line5:  Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=2G*", Operator:=xlAnd, _
            Criteria2:="<>*s*"
            GoTo bottom1
    Line10: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=2GS*", Operator:=xlAnd
    Line15: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=3G*", Operator:=xlAnd, _
            Criteria2:="<>*s*"
            GoTo bottom1
    Line20: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=3GS*", Operator:=xlAnd
            GoTo bottom1
    Line25: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=4G*", Operator:=xlAnd, _
            Criteria2:="<>*s*"
            GoTo bottom1
    Line30: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=4GS*", Operator:=xlAnd
            GoTo bottom1
    Line35: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*EH", Operator:=xlAnd
            GoTo bottom1
    Line40: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*H", Operator:=xlAnd, _
            Criteria2:="<>*E*"
            GoTo bottom1
    Line45: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*HM", Operator:=xlAnd
            GoTo bottom1
    Line50: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*J", Operator:=xlAnd, _
            Criteria2:="<>*F*"
            GoTo bottom1
    Line55: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*K", Operator:=xlAnd, _
            Criteria2:="<>*GK"
            GoTo bottom1
    Line60: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*M", Operator:=xlAnd, _
            Criteria2:="<>*HM"
            GoTo bottom1
    Line65: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*GK", Operator:=xlAnd
            GoTo bottom1
    Line70: Selection.AutoFilter Field:=2, Criteria1:="EJ7"
            Selection.AutoFilter Field:=10, Criteria1:="=*FJ", Operator:=xlAnd
            GoTo bottom1
    Line75: Selection.AutoFilter Field:=2, Criteria1:="BF7"
            Selection.AutoFilter Field:=10, Criteria1:="=3H*", Operator:=xlAnd
            GoTo bottom1
    Line80: Selection.AutoFilter Field:=2, Criteria1:="BF7"
            Selection.AutoFilter Field:=10, Criteria1:="=4FM*", Operator:=xlAnd
            GoTo bottom1
    Line85: Selection.AutoFilter Field:=2, Criteria1:="BF7"
            Selection.AutoFilter Field:=10, Criteria1:="=4H*", Operator:=xlAnd
            GoTo bottom1
    Line90: Selection.AutoFilter Field:=2, Criteria1:="BF7"
            Selection.AutoFilter Field:=10, Criteria1:="=*H", Operator:=xlAnd
            GoTo bottom1
    Line95: Selection.AutoFilter Field:=2, Criteria1:="BF7"
            Selection.AutoFilter Field:=10, Criteria1:="=*FJ", Operator:=xlAnd
            GoTo bottom1
    Line100:    Selection.AutoFilter Field:=2, Criteria1:="BF7"
            Selection.AutoFilter Field:=10, Criteria1:="=*EJ", Operator:=xlAnd
            GoTo bottom1
    Line105:    Selection.AutoFilter Field:=2, Criteria1:="BF7"
            Selection.AutoFilter Field:=10, Criteria1:="=*J", Operator:=xlAnd
            GoTo bottom1
    Line110:    Selection.AutoFilter Field:=2, Criteria1:="cg7"
            Selection.AutoFilter Field:=10, Criteria1:="=4FM*", Operator:=xlAnd
            GoTo bottom1
    Line115:    Selection.AutoFilter Field:=2, Criteria1:="cg7"
            Selection.AutoFilter Field:=10, Criteria1:="=4H*", Operator:=xlAnd
            GoTo bottom1
    Line120:    Selection.AutoFilter Field:=2, Criteria1:="cg7"
            Selection.AutoFilter Field:=10, Criteria1:="=*j", Operator:=xlAnd
            GoTo bottom1
    Line125:    Selection.AutoFilter Field:=2, Criteria1:="cg7"
            Selection.AutoFilter Field:=10, Criteria1:="=*FJ", Operator:=xlAnd
            GoTo bottom1
    Line130:    Selection.AutoFilter Field:=2, Criteria1:="cg7"
            Selection.AutoFilter Field:=10, Criteria1:="=*G", Operator:=xlAnd
            GoTo bottom1
    Line135:    Selection.AutoFilter Field:=2, Criteria1:="cg7"
            Selection.AutoFilter Field:=10, Criteria1:="=*G/J", Operator:=xlAnd
            GoTo bottom1
    Line140:  Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=2EIL*", Operator:=xlAnd
            GoTo bottom1
    Line145:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=2F*", Operator:=xlAnd
            GoTo bottom1
    Line150:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=3EIL*", Operator:=xlAnd
            GoTo bottom1
    Line155:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=3F*", Operator:=xlAnd
            GoTo bottom1
    Line160:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=4EIL*", Operator:=xlAnd
            GoTo bottom1
    Line165:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=4F*", Operator:=xlAnd
            GoTo bottom1
    Line170:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=5EIL*", Operator:=xlAnd
            GoTo bottom1
    Line175:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=*DH", Operator:=xlAnd
            GoTo bottom1
    Line180:   Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=*FK", Operator:=xlAnd
            GoTo bottom1
    Line185:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=*GM", Operator:=xlAnd
            GoTo bottom1
    Line190:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=*J", Operator:=xlAnd
            GoTo bottom1
    Line195:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=*K", Operator:=xlAnd
            GoTo bottom1
    Line200:    Selection.AutoFilter Field:=2, Criteria1:="dj9"
            Selection.AutoFilter Field:=10, Criteria1:="=*M", Operator:=xlAnd
            GoTo bottom1
    Line205:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=3GS*", Operator:=xlAnd
            GoTo bottom1
    Line210:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=4g*", Operator:=xlAnd
            GoTo bottom1
    Line215:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=4GS*", Operator:=xlAnd
            GoTo bottom1
    Line220:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=5g*", Operator:=xlAnd
            GoTo bottom1
    Line225:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=*J", Operator:=xlAnd
            GoTo bottom1
    Line230:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=*HM", Operator:=xlAnd
            GoTo bottom1
    Line235:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=*K", Operator:=xlAnd
            GoTo bottom1
    Line240:    Selection.AutoFilter Field:=2, Criteria1:="el7"
            Selection.AutoFilter Field:=10, Criteria1:="=*M", Operator:=xlAnd
            GoTo bottom1
    Line245:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=2EI*", Operator:=xlAnd
            GoTo bottom1
    Line250:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=3EI*", Operator:=xlAnd
            GoTo bottom1
    Line255:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=4EI*", Operator:=xlAnd
            GoTo bottom1
    Line260:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=*E/F", Operator:=xlAnd
            GoTo bottom1
    Line265:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=*F", Operator:=xlAnd
            GoTo bottom1
    line270:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=*G", Operator:=xlAnd
            GoTo bottom1
    Line275:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=*H", Operator:=xlAnd
            GoTo bottom1
    Line280:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=*J", Operator:=xlAnd
            GoTo bottom1
    Line285:    Selection.AutoFilter Field:=2, Criteria1:="BL5"
            Selection.AutoFilter Field:=10, Criteria1:="=*K", Operator:=xlAnd
            GoTo bottom1
    
            
            
            
            
            
                
            
                        
    GoTo bottom
    
    
    
    Line900:    Selection.AutoFilter Field:=2
                Selection.AutoFilter Field:=10
                
    bottom1: Range("E3").Select
                ActiveCell.FormulaR1C1 = ""
                    Range("E3").Value = "FAILED"
                        Range("A14").Select
        
                Range("G3").Select
                    ActiveCell.FormulaR1C1 = ""
                        Range("G3").Value = "AT RISK"
                            Range("A14").Select
                            
                Range("I3").Select
                    ActiveCell.FormulaR1C1 = ""
                        Range("I3").Value = "OVERHAULED"
                            Range("A14").Select
        
                Range("L3").Select
                    ActiveCell.FormulaR1C1 = ""
                        Range("L3").Value = "INSPECTED"
                            Range("A14").Select
                            
                Range("O3").Select
                    ActiveCell.FormulaR1C1 = ""
                        Range("O3").Value = "REPAIRED"
                            Range("A14").Select
                            
                Range("R3").Select
                    ActiveCell.FormulaR1C1 = ""
                        Range("R3").Value = "SCRAP"
                            Range("A14").Select
    bottom:
    Application.ScreenUpdating = True
    End Sub
    (The end bit after line 285 was in before I received the information about subtotalling colors)
    Last edited by royUK; January 7th, 2006 at 17:12. Reason: adding code tags please us in future

    Excel Video Tutorials / Excel Dashboards Reports


  6. #6
    Join Date
    2nd November 2005
    Location
    Wessex
    Posts
    1,267

    Re: Subtotalling cell colours

    First bit is easy

    Code:
    =SUMPRODUCT((SUBTOTAL(3,OFFSET(B12,ROW(B12:B5989)-MIN(ROW(B12:B5989)),,1))),--(B12:B5989="ej7"),--(LEFT(J12:J5989,3)="4GS"))
    HTH

    Bob

  7. #7
    Join Date
    26th January 2003
    Location
    Derbyshire,UK
    Posts
    19,293

    Re: Subtotalling cell colours

    I have added code tags for you in this post.Please read the rules you agreed to particularly concerning Code tags & their use. Thanks
    Hope that Helps

    Roy

    For free Excel tools & articles visit my web site

    If I have helped you and you feel like putting your hand in your pocket please make a donation to Children in Need

    RoyUK's Web Site

    royUK's Database Form

    Where to paste code from the Forum

    About me.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Possible Answers

  1. Subtotal Two Levels Based On Color Change Or Indent
    By RSDiggity in forum EXCEL HELP
    Replies: 2
    Last Post: June 25th, 2008, 11:50
  2. Change Font Color Based On Adjacent Cell Color
    By moneyshot1 in forum EXCEL HELP
    Replies: 3
    Last Post: April 18th, 2008, 11:19
  3. Replies: 3
    Last Post: April 12th, 2008, 11:04
  4. Color Data Points To Match Cell Color
    By nathantabb in forum EXCEL HELP
    Replies: 5
    Last Post: July 17th, 2007, 04:44
  5. Color Subtotal Dynamic Range
    By swilson2006 in forum EXCEL HELP
    Replies: 1
    Last Post: November 30th, 2006, 10:50

Bookmarks

Posting Permissions

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