Counting the number of coloured cells in excel

[funkmonsteruk]

I have a macro which takes a selection of cells (manually selected by the user, turns them a color (dependent upon which macro is chosen) and merges the selection of cells.

I need to be able to count the number occurances of each group of color cells.

eg.
a1:a5 are green
a5:a7 & b4:b7 are yellow

Green = 1
Yellow = 2

Can anyone help

 

[dwilson01]

This works for what I think you are trying to do. If this does not work for you (after adding CASEs for the colors you need), please send a sample file with just the merged cells and color information (no text or number required) to dave.wilson@takata.com.

Sub ColorTest()

Dim oCell As Object, isect As Object, strRng As String
Dim iRed As Integer, iGreen As Integer

ActiveSheet.UsedRange
strRng = "$A$1"
For Each oCell In ActiveSheet.UsedRange.Cells
  Set isect = Application.Intersect(Range(strRng), Range(oCell.Address))
  If isect Is Nothing Then
    strRng = oCell.MergeArea.Address
    Select Case oCell.Interior.ColorIndex
    Case 3  'Red
      iRed = iRed + 1
    Case 4  'Green
      iGreen = iGreen + 1
    End Select
  End If
Next
Debug.Print "Number of RED cells " & iRed
Debug.Print "Number of GREEN cells " & iGreen

End Sub

Dave

 

[rmikesmith]

Dave,

Your routine works nicely, but I believe funkmonsteruk wanted the number of distinct ranges of a given color rather than the total number of cells.

The following will will determine the total number of distinct areas for any of the 56 possible colors of the active color palette:

Type CellInfo
  Rng As Range
  HasColor As Boolean
End Type


Sub GetNumberOfColoredAreas()
Dim oCell As Range
Dim CMap(1 To 56) As CellInfo
Dim CIndex As Integer
Dim i As Integer
Dim RowNum As Integer

  For Each oCell In ActiveSheet.UsedRange
    CIndex = oCell.Interior.ColorIndex
    If CIndex > 0 Then
      CMap(CIndex).HasColor = True
      If CMap(CIndex).Rng Is Nothing Then
        Set CMap(CIndex).Rng = oCell
      Else
        Set CMap(CIndex).Rng = Application.Union(CMap(CIndex).Rng, oCell)
      End If
    End If
  Next oCell

  RowNum = 2
  Worksheets.Add
  With ActiveSheet
    Range("A1").Value = "Number of distinct areas by color:"
    .Cells(2, 1).Value = "Color"
    .Cells(2, 2).Value = "# of Areas"
    For i = 1 To 56
      If CMap(i).HasColor Then
        RowNum = RowNum + 1
        .Cells(RowNum, 1).Interior.ColorIndex = i
        .Cells(RowNum, 2).Value = CMap(i).Rng.Areas.Count
      End If
    Next i
  End With
  
End Sub

Note: Everything after the For Each..Next loop is for demo purposes only. It creates a new worksheet and displays each color used and the number of distinct areas containing that color. Your actual procedure would likely do something else with the information.

Regards,
M. Smith

 

[funkmonsteruk]

This works fantastically rmikesmith, thanx for the code. If i could bother you even further there are a couple more things which i need to do with this spreedsheet.

Firstly i need to assign each of 8 colors which will exist in the spreedsheet a name - this is for reporting purposes

Secondly i need to call the page which is created by the above code a name such as results page

and finally i need to individually count the number of colored cells on each of 20 pages, any suggestions

Funkmonsteruk

 

[rmikesmith]

Funkmonsteruk,

I can't quite get a handle on what you're trying to do. More info, please:

Firstly i need to assign each of 8 colors which will exist in the spreedsheet a name - this is for reporting purposes How will this be used? Are the 8 colors known up front?

Secondly i need to call the page which is created by the above code a name such as results page What page is being created and by what code?

and finally i need to individually count the number of colored cells on each of 20 pages Are the 20 pages static (i.e. are the same 20 pages always present in the workbook)? Where or how will the counts be used (e.g. stored on a worksheet in particular cells)?

Regards,
Mike

 

[funkmonsteruk]

Hi Mike,

1 - Each of the colors is known up front and they refer to task, eg Green is a 'Branch Visit', Red is something called a 'sweep'

2 - The code you have given me to count the number of distinct groups of colored cells gives the results on a new sheet which it creates, i would like this sheet to automatically be called 'Results' or something similar

3 - Yes the same 20 pages are always present in the workbook, they refer to our 20 field operatives.

The counts will always refer to a range of cells on each sheet, this is the diary area where each field operative adds color coded details of their daily tasks.

Cheers

Funkmonster

 

[rmikesmith]

Funkmonsteruk,

I think I'm beginning to get it. Let's see:

There are 20 worksheets, one for each field operative. Each operative will run the macros you previously created to merge/color-code various ranges on his particular sheet. You want a routine that will count each of these colored regions, which actually represent tasks, and put the totals into a "results" worksheet, for each field operative. So, the results sheet might look something like:

Task1 Task2 Task3 ... Task8

Operative1 1 3 5 4
Operative2 3 1 4 3
....
Operative20 5 4 4 6


Is this about right? When this summarizing routine is run, should it clear the prevoious info from the "Results" worksheet? Since it seems likely that the number of field operatives could change over time, the routine should probably be able to detect these particular sheets. Are you using names?

Post back.

Regards,
Mike

 

[funkmonsteruk]

Mike

This sounds exactly right, A new set of spreedsheets will be created weekly, so the sumarizing routine will only have to be run once on each spreedsheet, this will give weekly results.

From time to time new field operatives will be added, and i will be using there names as the title for there sheet.

Regards,
Funkmonster

 

[rmikesmith]

Funkmonsteruk,

I'm getting close to having the demo workbook ready. Please post your email address and I'll send it to you.

Regards,
Mike

 

[funkmonsteruk]

Hi Mike,

Your halp here is very much appreciated - my e-mail address is: smyth_hustle@hotmail.com.

Funkmonsteruk