Loading
Ozgrid Excel Help & Best Practices Forums

Excel Video Tutorials / 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!!

    VB:
     
    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 11: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

    VB:
     '---------------------------------------------------------------------
    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 
    
    
    and I would use it in a worksheet like so

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

    VB:
    =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

    VB:
    =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 11: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..........

    VB:
    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 16: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

    VB:
    =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
    17,917

    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, 10:50
  2. Change Font Color Based On Adjacent Cell Color
    By moneyshot1 in forum EXCEL HELP
    Replies: 3
    Last Post: April 18th, 2008, 10:19
  3. Replies: 3
    Last Post: April 12th, 2008, 10:04
  4. Color Data Points To Match Cell Color
    By nathantabb in forum EXCEL HELP
    Replies: 5
    Last Post: July 17th, 2007, 03:44
  5. Color Subtotal Dynamic Range
    By swilson2006 in forum EXCEL HELP
    Replies: 1
    Last Post: November 30th, 2006, 09: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