Counting coloured cells

J

jarhead58

Active Member
Joined
Sep 21, 2017
Messages
364
Office Version
  1. 2021
Platform
  1. Windows
Hey all,

Title says it all! Here's what I'm trying to do! Let me know if this can be done! TIA!!

GHIJKLMNOP
4Blue or not

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>
Sheet2​

​
If G3:K3 is blue count it. If qty is 3, G11=a number, 4=another number…
OR if P3 and G3:K3 is blue and qty is >=2, G11=this number

G
11Some Num

<tbody>
</tbody>
Sheet2​
 
Last edited:
Sort by date Sort by votes
The findcolor code is written to work on one cell. The code works for me if I make M12 yellow I get 65535. When M12 is then conditional formatted with blue I get 12611584. This may require looking at your workbook. Can you put it on dropbox or something and post a link.
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
Scott T said:
The findcolor code is written to work on one cell. The code works for me if I make M12 yellow I get 65535. When M12 is then conditional formatted with blue I get 12611584. This may require looking at your workbook. Can you put it on dropbox or something and post a link.
Click to expand...

It works for the single cell correctly thanks! Now just have to tweak it for what I need!
 
Upvote 0
Hey Scott T,

I've finally got the code doing what I need. To automate the code after the numbers are updated, it needs to be triggered by an event mod correct?
 
Upvote 0
Yes please post the code you have that works. What event do you want to trigger the macro? If it is a change in value of a cell then what cells should trigger the code?
 
Upvote 0
The range that will update is B2:G2


Sub ccolor()
Dim cell As Range
Dim mycount As Long
Dim mycountplus As Long
'I assume you want to clear W22 if not you can remove the line below.
Range("V21").ClearContents
For Each cell In Range("V14:Z14")
If cell.DisplayFormat.Interior.Color = 12611584 Then
mycount = mycount + 1
End If
Next cell
'MsgBox (mycount)
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount = 0 Then
mycountplus = mycountplus + 1
MsgBox ("4")
Else
If Range("AA14").DisplayFormat.Interior.Color <> 12611584 And mycount >= 1 Then
End If
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount >= 1 Then ' Then
mycountplus = mycountplus + 1
mycount = mycount + 1
End If
'MsgBox ("mycountplus is" & mycountplus)
Select Case mycount
Case 0
MsgBox ("0")
Case 1
MsgBox ("10")
Case 1 + mycountplus
MsgBox ("14")
Case 2
MsgBox ("20")
Case 2 + mycountplus
MsgBox ("30")
Case 3
MsgBox ("40")
Case 3 + mycountplus
MsgBox ("50")
Case 4
MsgBox ("100")
Case 4 + mycountplus
MsgBox ("200")
Case 5
MsgBox ("300")
Case 5 + mycountplus
MsgBox ("500")
End Select
End If
End Sub
 
Upvote 0
Right click on the tab that have B2:G2 that you want to trigger the code and past this code there. Any time the value of B2:G2 on that sheet changes value the code should run.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B2:G2")) Is Nothing Then
Application.EnableEvents = False


Dim cell As Range
Dim mycount As Long
Dim mycountplus As Long
'I assume you want to clear W22 if not you can remove the line below.
Range("V21").ClearContents


For Each cell In Range("V14:Z14")
    If cell.DisplayFormat.Interior.Color = 12611584 Then
    mycount = mycount + 1
    End If
Next cell


'MsgBox (mycount)
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount = 0 Then
    mycountplus = mycountplus + 1
    MsgBox ("4")
Else
    If Range("AA14").DisplayFormat.Interior.Color <> 12611584 And mycount >= 1 Then
End If
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount >= 1 Then ' Then
    mycountplus = mycountplus + 1
    mycount = mycount + 1
End If
'MsgBox ("mycountplus is" & mycountplus)
    Select Case mycount
        Case 0
        MsgBox ("0")
        Case 1
        MsgBox ("10")
        Case 1 + mycountplus
        MsgBox ("14")
        Case 2
        MsgBox ("20")
        Case 2 + mycountplus
        MsgBox ("30")
        Case 3
        MsgBox ("40")
        Case 3 + mycountplus
        MsgBox ("50")
        Case 4
        MsgBox ("100")
        Case 4 + mycountplus
        MsgBox ("200")
        Case 5
        MsgBox ("300")
        Case 5 + mycountplus
        MsgBox ("500")
    End Select
End If


End If
Application.EnableEvents = True
End Sub
 
Upvote 0
Scott T said:
Right click on the tab that have B2:G2 that you want to trigger the code and past this code there. Any time the value of B2:G2 on that sheet changes value the code should run.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("B2:G2")) Is Nothing Then
Application.EnableEvents = False


Dim cell As Range
Dim mycount As Long
Dim mycountplus As Long
'I assume you want to clear W22 if not you can remove the line below.
Range("V21").ClearContents


For Each cell In Range("V14:Z14")
    If cell.DisplayFormat.Interior.Color = 12611584 Then
    mycount = mycount + 1
    End If
Next cell


'MsgBox (mycount)
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount = 0 Then
    mycountplus = mycountplus + 1
    MsgBox ("4")
Else
    If Range("AA14").DisplayFormat.Interior.Color <> 12611584 And mycount >= 1 Then
End If
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount >= 1 Then ' Then
    mycountplus = mycountplus + 1
    mycount = mycount + 1
End If
'MsgBox ("mycountplus is" & mycountplus)
    Select Case mycount
        Case 0
        MsgBox ("0")
        Case 1
        MsgBox ("10")
        Case 1 + mycountplus
        MsgBox ("14")
        Case 2
        MsgBox ("20")
        Case 2 + mycountplus
        MsgBox ("30")
        Case 3
        MsgBox ("40")
        Case 3 + mycountplus
        MsgBox ("50")
        Case 4
        MsgBox ("100")
        Case 4 + mycountplus
        MsgBox ("200")
        Case 5
        MsgBox ("300")
        Case 5 + mycountplus
        MsgBox ("500")
    End Select
End If


End If
Application.EnableEvents = True
End Sub
Click to expand...

Are you talking about Sheet1 tab and the Worksheet dropdown?
Already have this inside the following code in this event!

Private Sub Worksheet_Change(ByVal Target As Range)
'Sorts blank rows to the bottom as they occur


'Prevents endless loops
Application.EnableEvents = False
'They have more than one cell selected
If Target.Cells.Count >= 1 Then Exit Sub
If Target.Column <> 7 Then Exit Sub
If WorksheetFunction.CountA(Target.EntireRow) <> 0 Then
Me.UsedRange.Sort Key1:=[A2], Order1:=xlAscending, _
Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
Orientation:=xlTopToBottom


End If
Application.EnableEvents = True

End Sub
 
Upvote 0
If Sheet 1 is where the cells that will trigger the macro are located then the code needs to be merged with the existing event as you can only have one change event. See below. If the cells that will trigger the macro are on a different sheet then put it there.

Note your code was exiting the sub with out turning events back on. If you turn events off make sure to turn them back on before any point that exits the sub.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)'Stop
If Not Intersect(Target, Range("B2:G2")) Is Nothing Then
Application.EnableEvents = False




Dim cell As Range
Dim mycount As Long
Dim mycountplus As Long
'I assume you want to clear W22 if not you can remove the line below.
Range("V21").ClearContents




For Each cell In Range("V14:Z14")
    If cell.DisplayFormat.Interior.Color = 12611584 Then
    mycount = mycount + 1
    End If
Next cell




'MsgBox (mycount)
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount = 0 Then
    mycountplus = mycountplus + 1
    MsgBox ("4")
Else
    If Range("AA14").DisplayFormat.Interior.Color <> 12611584 And mycount >= 1 Then
End If
If Range("AA14").DisplayFormat.Interior.Color = 12611584 And mycount >= 1 Then ' Then
    mycountplus = mycountplus + 1
    mycount = mycount + 1
End If
'MsgBox ("mycountplus is" & mycountplus)
    Select Case mycount
        Case 0
        MsgBox ("0")
        Case 1
        MsgBox ("10")
        Case 1 + mycountplus
        MsgBox ("14")
        Case 2
        MsgBox ("20")
        Case 2 + mycountplus
        MsgBox ("30")
        Case 3
        MsgBox ("40")
        Case 3 + mycountplus
        MsgBox ("50")
        Case 4
        MsgBox ("100")
        Case 4 + mycountplus
        MsgBox ("200")
        Case 5
        MsgBox ("300")
        Case 5 + mycountplus
        MsgBox ("500")
    End Select
End If


End If
Application.EnableEvents = True




'Sorts blank rows to the bottom as they occur
'Prevents endless loops
Application.EnableEvents = False
'They have more than one cell selected
If Target.Cells.Count >= 1 Then
    Application.EnableEvents = True 'you need to turn event on again before you exit the sub
    Exit Sub
End If
If Target.Column <> 7 Then
    Application.EnableEvents = True
    Exit Sub
End If
If WorksheetFunction.CountA(Target.EntireRow) <> 0 Then
    Me.UsedRange.Sort Key1:=[A2], Order1:=xlAscending, _
    Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
    Orientation:=xlTopToBottom


End If
Application.EnableEvents = True


End Sub
 
Upvote 0
Ok, still not doing the code! I change B2:G2 via the form mode along with the Sort newest to lowest function to bring it to the B2:G2 range.
 
Upvote 0
Make sure events are turned on

Open the immediate window (Ctrl+G) in the VBA editor.
Put this in the immediate window and press enter.

Code: 
Application.EnableEvents = True
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Help with FilterXML formula
Replies
0
Views
1K
montex01
M
T
  • Question
Possible to Keep some cells visible while rows are hidden?
Replies
1
Views
226
6StringJazzer
6StringJazzer
G
  • Question
Formula to count with multiple criteria and exclude from a separate column, then sort by count in one cell with spill
Replies
0
Views
356
Greenbehindthecells
G
P
  • Solved
Calculating shortest to longest distances between Zip Codes (using latitude and longitude)
2 3
Replies
25
Views
979
pawcoyote
P
MrDB4Excel
  • Question
If Find Blank Cell
Replies
0
Views
412
MrDB4Excel
MrDB4Excel

Forum statistics

Threads
1,215,161
Messages
6,123,378
Members
449,097
Latest member
Jabe

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top