• 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.

Code Required

ShoaibAli

New Member
I am looking for code which will count two color from each sheet that are Green and Pink and here are RGB(244, 204, 204) & RGB(183, 225, 205).

First Code will count that how many cells have green and pink color in column A,B,C,D and so on till used range .
Second Code will create a sheet with summary name and paste the result over there
Third Code will paste sheet names and their headers in summary sheet and thier count for Green and Pink Color.

I have made a summary sheet manually but want a code which will make the summary sheet automatically and paste the Green and Pink count.
 

Attachments

  • 2 - Copy.xlsx
    47.1 KB · Views: 1
ShoaibAli
Would You refresh Your memory ...

How to get the Best Results at Chandoo.org
  • Use Relevant words in the Title and in the tag Box, This will aid future searches.
 
What about the rule regarding cross posting? You should know that by now, you've ignored it plenty of times.

 
I did not ignored i am consistently looking for code from google its been 3 hours finding the code i missed to mention i apologise.



Code:
Public Sub CountColorCells()
    'Variable declaration
    Dim rng As Range
    Dim lColorCounter As Long
    Dim rngCell As Range
    'Set the range
    Set rng = Sheet2.Range("J2:J1000")
    Set rng = Sheet2.Range("K2:K1000")
    Set rng = Sheet2.Range("L2:L1000")
    Set rng = Sheet2.Range("M2:M1000")
    Set rng = Sheet2.Range("N2:N1000")
    Set rng = Sheet2.Range("O2:O1000")
    Set rng = Sheet2.Range("P2:P1000")
    Set rng = Sheet2.Range("Q2:Q1000")
    Set rng = Sheet2.Range("R2:R1000")
    Set rng = Sheet2.Range("S2:S1000")
    Set rng = Sheet2.Range("T2:T1000")
    Set rng = Sheet2.Range("U2:U1000")
    Set rng = Sheet2.Range("V2:V1000")
    Set rng = Sheet2.Range("W2:W1000")
    Set rng = Sheet2.Range("X2:X1000")
    Set rng = Sheet2.Range("Y2:Y1000")
    Set rng = Sheet2.Range("Z2:Z1000")
    'loop throught each cell in the range
    For Each rngCell In rng
        'Checking Yellor color
        If Cells(rngCell.Row, rngCell.Column).DisplayFormat.Interior.Color = RGB(183, 225, 205) Then
            lColorCounter = lColorCounter + 1
        End If
    Next
    'Display the value in cell
    Sheet2.Range("J1") = lColorCounter
    Sheet2.Range("K1") = lColorCounter
    Sheet2.Range("L1") = lColorCounter
    Sheet2.Range("M1") = lColorCounter
    Sheet2.Range("N1") = lColorCounter
    Sheet2.Range("O1") = lColorCounter
    Sheet2.Range("P1") = lColorCounter
    Sheet2.Range("Q1") = lColorCounter
    Sheet2.Range("R1") = lColorCounter
    Sheet2.Range("S1") = lColorCounter
    Sheet2.Range("T1") = lColorCounter
    Sheet2.Range("U1") = lColorCounter
    Sheet2.Range("V1") = lColorCounter
    Sheet2.Range("W1") = lColorCounter
    Sheet2.Range("X1") = lColorCounter
    Sheet2.Range("Y1") = lColorCounter
    Sheet2.Range("Z1") = lColorCounter



End Sub
 
Back
Top