• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

count by color and sum cells colored using conditional formatting

A

Afarag

Member
Dears,

I ask for help as i know that this case isn't easy :(
i ask for a way that i want to be able to count conditional formatting colors cell,
i have been tried more than one solution but didn't get it
and try to apply what described here
http://www.cpearson.com/excel/CFColors.htm
but unfortunately didn't get pure UDF can achieve
is there any another solution or some clarification for the above link

Gratefully,
 
I too was looking for the same unfortunately i dont have any straight way answer for the same but can tell you the trick which i use. You can count the cells by the same function or say by the same condition which you are using to get Conditional formatting color. No. of counts where conditions are true.
 
Hi Bhawani,

thanks for following, i'm rather despaired to achieve it, i see multiple non straight way but don't able to apply
you can take a look to the sheet may find the solution some how by counting colors or by outcome data

0


in additional to i can achieve it by indirect way as i have a code that let me migrate the conditional sheet to a new one but unfortunately didn't serve the color, can i migrate it and retains the real color color, then use the counting color with the new sheet

i have 3 codes that i want to link to achieve that
1st: the VBA that let me migrate the conditional sheet but need to modify to paste the real color

Code: 
Sub CopyNew()
    Dim wsNew As Worksheet
    Dim myRange As Range
    Dim strName As String
   
    Application.ScreenUpdating = False
   
    With Worksheets("preview")
        'Can't use / in sheet names, changed format:
        strName = Format(.Range("C1").Value, "dd-mmm-yyyy")
        Set myRange = .Range("A1:BY200")
       
        Set wsNew = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets("preview"))
        wsNew.Name = strName
        myRange.Copy
        wsNew.Cells(1, 1).PasteSpecial xlPasteValues
        wsNew.Cells(1, 1).PasteSpecial xlPasteFormats
        wsNew.Cells(1, 1).PasteSpecial xlPasteColumnWidths
        Application.CutCopyMode = False
       
        Call SortSheets
        .Move Before:=Sheets(1)    'Move the "Final" sheet to the be the first
    End With
   
    Application.ScreenUpdating = True
End Sub

Sub SortSheets()
    Dim i As Long, j As Long
 
    For i = 1 To Sheets.Count
        For j = 1 To Sheets.Count - 1
            If UCase$(Sheets(j).Name) > UCase$(Sheets(j + 1).Name) Then
                Sheets(j).Move After:=Sheets(j + 1)
            End If
        Next j
    Next i
End Sub



2ed: VBA let me count/sum color cell

Code: 
Function sum_color(myRange As Range, myColor As Range, Optional myType = 0) As Double
        Dim summ As Double
        Dim clr As Long
        clr = myColor.Interior.Color
       
        summ = 0
        For Each c In myRange
            If clr = c.Interior.Color Then
                If myType = 1 Then
                  summ = summ + c.Text
                ElseIf myType = 0 Then
                  summ = summ + 1
                End If
            End If
        Next
        sum_color = summ
End Function


the last that let me apply my function in a new sheet, what i ask after migrate the sheet automatically run the last VBA to apply the function in the desired range

Code: 
Option Explicit
Sub FillWithFormula()
    Const sFormula As String = _
        "=sum_color(I5:BP5,$F$4,1)/(sum_color(I5:BP5,$F$4,0)*15)"
    Dim R As Range
Set R = Range("C5:C200")
R.Formula = sFormula
End Sub

is there available, the attached sheet
http://1drv.ms/1jszK8V

Gratefully,
 
Dears,

is there available to modify the above codes to get the desired goal
from the new migrated sheet i want paste it with a real color and counting colors will apply from the 2nd and 3ed codes

Gratefully,
 
Hi Afarag, i read all three codes above but unfortunately their return togetherly will not give us the thing that we require.
1st Code - Copy pasting cells from one place to another with format and sorting sheets as per our requirement
2nd Code - Function for Counting interior colors of cells
3rd Code - Use of function in 2nd code.

and again unfortunately none of above is not counting formatted cell colors atleast clearly in 2nd & 3rd;
1st coding is copy pasting formating and destination also get CF in it. :(

you should go through with the function which you are using for meeting your conditional formatting.

PS: I am also searching for solution will let you know once getting it :).
i have not read anywhere that it is impossible it means there are still probability of getting it.
 
in brief, I ask to modify the 1st code to paste the color but non conditionally formatting paste it as a real color to be able counting by the 2nd code and the 3rd to fill the range automatically by the UDF that activate from 2nd code
 
I am not sure whether it is possible or not, but i dont have any ideas about copying formatting without condition from conditional formatting cells. Might any of our sirs (Ninjas) have any about this.
 
Hi Afarag,
Can you please share your file on which you want exact workings. some type of sample file with all criterias and possiblities on it. I will try and will revert to you soon.
 
Hi Bhawani,

Great your efforts you have been provided,
you can take a look to the attached sheet from URL: http://1drv.ms/1rgMMy0
I try to find an alternative solution by converting the conditional formatting color to real color, to be easier to count and used the below code, but something go wrong, sounds like this code does a wonderful job, but not with my sheet would probably that there is some issues should be considered and I did not know that
in brief, Let's strive i ask to count/sum the green colors in "Preview" sheet

Code: 
Sub SetColorsBasedOnCFRules()
'this routine takes the range defined in
'Const rangeToChange and
'converts the actual Fill color for the cells
'in it to the color that would be set if the
'conditional format for the cell were true
'It stops at the first true test
'
'It works with the sheet named as
'Const targetWSName
'
  Const targetWSName = "preview"    'change as required
  Const rangeToChange = "I4:BP300"  'change as required
  Dim myRange As Range
  Dim anyCell As Range
  Dim myCFRule As Variant
  Dim myRuleResult As Boolean
  Dim myPCI As Variant    ' .PatternColorIndex
  Dim myTC As Variant    ' .ThemeColor
  Dim myTAS As Variant    ' .TintAndShade
  Dim RCL As Integer      ' rule count loop
 
  Set myRange = Worksheets(targetWSName).Range(rangeToChange)
  For Each anyCell In myRange
    'does it have CF formula?
    If anyCell.FormatConditions.Count > 0 Then
      'test each rule in turn, quit at first TRUE result
      For RCL = 1 To anyCell.FormatConditions.Count
        myCFRule = anyCell.FormatConditions(RCL).Formula1
        myRuleResult = Evaluate(myCFRule)
        If myRuleResult = True Then
          'Conditional format would be applied
          'get values from the CF rule conditions
          With anyCell.FormatConditions(RCL).Interior
            myPCI = .PatternColorIndex
            myTC = .ThemeColor
            myTAS = .TintAndShade
          End With
          'make the color permanent
          With anyCell.Interior
            ' set the cell's .Interior.PatternColorIndex
            .PatternColorIndex = myPCI
            '  set the cell's .Interior.ThemeColor
            .ThemeColor = myTC
            '  set the cell's .Interior.TintAndShade
            .TintAndShade = myTAS
          End With
          Exit For ' go to next cell
        End If
      Next ' end RCL loop
    End If ' end test for .Count>0
  Next ' end anyCell loop
  Set myRange = Nothing
  MsgBox "Task Finished"
End Sub



Gratefully,
 
You must log in or register to reply here.
Back
Top