VBA code to count colors/shapes?

I've gotten great help from this group recently and am thankful. I'm
hopeful someone has an answer (or web link) for the following need. I have
a worksheet that has about 100 rectangles that have been renamed to various
names. Some of these rectangles are red, others blue, and so forth.

Is there any VBA code that will allow me to total how many of these
rectangles are red, how many are blue, then plant those figures into a cell
so I can total them up and create a graph?

Sub test()
Dim shp As Shape
Dim nRed As Long
Dim nBlue As Long

For Each shp In ActiveSheet.Shapes
Select Case shp.Fill.ForeColor.SchemeColor
Case 10: nRed = nRed + 1
Case 12: nBlue = nBlue + 1
End Select
Next shp
End Sub

You will have to experiment to see what the schemecolor values are, they are
not the sam e as colorindex (!)
--
HTH

Bob Phillips

"Nimrod" <[email protected]> wrote in message
news:[email protected]...
> I've gotten great help from this group recently and am thankful. I'm
> hopeful someone has an answer (or web link) for the following need. I
have
> a worksheet that has about 100 rectangles that have been renamed to
various
> names. Some of these rectangles are red, others blue, and so forth.
>
> Is there any VBA code that will allow me to total how many of these
> rectangles are red, how many are blue, then plant those figures into a
cell
> so I can total them up and create a graph?
>
>

I tested this VBA code and I get a Permission Denied error. The VBA editor
highlights "Select Case shp.fill....." Though I am associating this code
with a command button:

Private Sub CommandButton1_Click()

Dim shp As Shape
Dim nRed As Long
Dim nBlue As Long

For Each shp In ActiveSheet.Shapes
Select Case shp.Fill.ForeColor.SchemeColor
.....snip

What did I do wrong? Thanks again in advance. I will continue to play
around with this code.

Scott


"Bob Phillips" <[email protected]> wrote in message
news:%[email protected]...
> Sub test()
> Dim shp As Shape
> Dim nRed As Long
> Dim nBlue As Long
>
> For Each shp In ActiveSheet.Shapes
> Select Case shp.Fill.ForeColor.SchemeColor
> Case 10: nRed = nRed + 1
> Case 12: nBlue = nBlue + 1
> End Select
> Next shp
> End Sub
>
> You will have to experiment to see what the schemecolor values are, they
> are
> not the sam e as colorindex (!)
> --
> HTH
>
> Bob Phillips
>
> "Nimrod" <[email protected]> wrote in message
> news:[email protected]...
>> I've gotten great help from this group recently and am thankful. I'm
>> hopeful someone has an answer (or web link) for the following need. I
> have
>> a worksheet that has about 100 rectangles that have been renamed to
> various
>> names. Some of these rectangles are red, others blue, and so forth.
>>
>> Is there any VBA code that will allow me to total how many of these
>> rectangles are red, how many are blue, then plant those figures into a
> cell
>> so I can total them up and create a graph?
>>
>>
>
>

What Excel version?

--
HTH

Bob Phillips

"Nimrod" <[email protected]> wrote in message
news:[email protected]...
> I tested this VBA code and I get a Permission Denied error. The VBA
editor
> highlights "Select Case shp.fill....." Though I am associating this code
> with a command button:
>
> Private Sub CommandButton1_Click()
>
> Dim shp As Shape
> Dim nRed As Long
> Dim nBlue As Long
>
> For Each shp In ActiveSheet.Shapes
> Select Case shp.Fill.ForeColor.SchemeColor
> ....snip
>
> What did I do wrong? Thanks again in advance. I will continue to play
> around with this code.
>
> Scott
>
>
> "Bob Phillips" <[email protected]> wrote in message
> news:%[email protected]...
> > Sub test()
> > Dim shp As Shape
> > Dim nRed As Long
> > Dim nBlue As Long
> >
> > For Each shp In ActiveSheet.Shapes
> > Select Case shp.Fill.ForeColor.SchemeColor
> > Case 10: nRed = nRed + 1
> > Case 12: nBlue = nBlue + 1
> > End Select
> > Next shp
> > End Sub
> >
> > You will have to experiment to see what the schemecolor values are, they
> > are
> > not the sam e as colorindex (!)
> > --
> > HTH
> >
> > Bob Phillips
> >
> > "Nimrod" <[email protected]> wrote in message
> > news:[email protected]...
> >> I've gotten great help from this group recently and am thankful. I'm
> >> hopeful someone has an answer (or web link) for the following need. I
> > have
> >> a worksheet that has about 100 rectangles that have been renamed to
> > various
> >> names. Some of these rectangles are red, others blue, and so forth.
> >>
> >> Is there any VBA code that will allow me to total how many of these
> >> rectangles are red, how many are blue, then plant those figures into a
> > cell
> >> so I can total them up and create a graph?
> >>
> >>
> >
> >
>
>

Bob,

I have tried the code on both Excel with Office XP and again with Excel 2003
and it's not working with either. Any help with a work around would be
appreciated.

One more question. Is there a good book you can recommend that covers
VB/VBA for Excel which covers things like this? Again, thanks for your
help.

Best Regards,
Scott


"Bob Phillips" <[email protected]> wrote in message
news:[email protected]...
> What Excel version?
>
>> I tested this VBA code and I get a Permission Denied error. The VBA
> editor
>> highlights "Select Case shp.fill....." Though I am associating this code
>> with a command button:
>>
>> Private Sub CommandButton1_Click()
>>
>> Dim shp As Shape
>> Dim nRed As Long
>> Dim nBlue As Long
>>
>> For Each shp In ActiveSheet.Shapes
>> Select Case shp.Fill.ForeColor.SchemeColor
>> ....snip
>>
>> What did I do wrong? Thanks again in advance. I will continue to play
>> around with this code.

I've still been unable to solve the "Permission Denied" bug in this code.
My Excel is version 2002 and on another machine I have 2003. The "Help"
button if I remark out the "On Error" line mentions a locked element. But
my worksheet is not locked. Double-clicking on the shapes reveals a protect
tab, but there it says protecting does no good unless the sheet itself is
protected (which it is not). Anybody have a solution so I can tally up how
many red shapes, blue shapes, ect?

TIA

Scott

Private Sub cboCountColors_Click()
On Error GoTo Err_cboCountColors
Dim shp As Shape
Dim nRed As Long
Dim nBlue As Long

For Each shp In ActiveSheet.Shapes
Select Case shp.Fill.ForeColor.SchemeColor
Case 10: nRed = nRed + 1
Case 12: nBlue = nBlue + 1
End Select
Next shp

Exit_cboCountColors:
Exit Sub

Err_cboCountColors:
MsgBox Err.Description
Resume Exit_cboCountColors
End Sub

After much experimenting, I found that my button property needed to be set
to "TakeFocusOnClick = True" and the code works (hangs head low). So now
the code works. Thanks to all for the help.

Scott


"Nimrod" <[email protected]> wrote in message
news:u%[email protected]...
> I've still been unable to solve the "Permission Denied" bug in this code.
> My Excel is version 2002 and on another machine I have 2003. The "Help"
> button if I remark out the "On Error" line mentions a locked element. But
> my worksheet is not locked. Double-clicking on the shapes reveals a
> protect tab, but there it says protecting does no good unless the sheet
> itself is protected (which it is not). Anybody have a solution so I can
> tally up how many red shapes, blue shapes, ect?
>
> TIA
>
> Scott
>
> Private Sub cboCountColors_Click()
> On Error GoTo Err_cboCountColors
> Dim shp As Shape
> Dim nRed As Long
> Dim nBlue As Long
>
> For Each shp In ActiveSheet.Shapes
> Select Case shp.Fill.ForeColor.SchemeColor
> Case 10: nRed = nRed + 1
> Case 12: nBlue = nBlue + 1
> End Select
> Next shp
>
> Exit_cboCountColors:
> Exit Sub
>
> Err_cboCountColors:
> MsgBox Err.Description
> Resume Exit_cboCountColors
> End Sub
>
>

I see nothing in your code that would relate to the takefocusonclick
property.

What I found was that the commandbutton caused a permission denied error
because it doesn't support the properties you are trying to check. If I
avoided the commandbutton, it worked.

Private Sub cboCountColors_Click()
On Error GoTo Err_cboCountColors
Dim shp As Shape
Dim nRed As Long
Dim nBlue As Long

For Each shp In ActiveSheet.Shapes
If shp.Name <> "cboCountColors" Then
Select Case shp.Fill.ForeColor.SchemeColor
Case 10: nRed = nRed + 1
Case 12: nBlue = nBlue + 1
End Select
End If
Next shp

Exit_cboCountColors:
Debug.Print nRed, nBlue
Exit Sub
Err_cboCountColors:
MsgBox Err.Description
Resume Exit_cboCountColors
End Sub

This was true with both TakeFocusOnClick set to either True or False.

--
Regards,
Tom Ogilvy


"Nimrod" <[email protected]> wrote in message
news:%[email protected]...
> After much experimenting, I found that my button property needed to be set
> to "TakeFocusOnClick = True" and the code works (hangs head low). So now
> the code works. Thanks to all for the help.
>
> Scott
>
>
> "Nimrod" <[email protected]> wrote in message
> news:u%[email protected]...
> > I've still been unable to solve the "Permission Denied" bug in this
code.
> > My Excel is version 2002 and on another machine I have 2003. The "Help"
> > button if I remark out the "On Error" line mentions a locked element.
But
> > my worksheet is not locked. Double-clicking on the shapes reveals a
> > protect tab, but there it says protecting does no good unless the sheet
> > itself is protected (which it is not). Anybody have a solution so I can
> > tally up how many red shapes, blue shapes, ect?
> >
> > TIA
> >
> > Scott
> >
> > Private Sub cboCountColors_Click()
> > On Error GoTo Err_cboCountColors
> > Dim shp As Shape
> > Dim nRed As Long
> > Dim nBlue As Long
> >
> > For Each shp In ActiveSheet.Shapes
> > Select Case shp.Fill.ForeColor.SchemeColor
> > Case 10: nRed = nRed + 1
> > Case 12: nBlue = nBlue + 1
> > End Select
> > Next shp
> >
> > Exit_cboCountColors:
> > Exit Sub
> >
> > Err_cboCountColors:
> > MsgBox Err.Description
> > Resume Exit_cboCountColors
> > End Sub
> >
> >
>
>

Thanks again for your help Tom. I have another question. I have several
buttons I choose to use to change a rectangle to various colors. All of my
buttons begin with "cbo" (something I picked up along the way). I have been
trying to figure out how to use InStr (x,y) to skip shapes beginning with
"cbo" but I can't get the syntax right. Any ideas? I was figuring on "If
Instr(whatever) > 0 Then ... end if"

Again, thank you kindly for your assistance.

Scott

"Tom Ogilvy" <[email protected]> wrote in message
news:[email protected]...
>I see nothing in your code that would relate to the takefocusonclick
> property.
>
> What I found was that the commandbutton caused a permission denied error
> because it doesn't support the properties you are trying to check. If I
> avoided the commandbutton, it worked.
>
> Private Sub cboCountColors_Click()
> On Error GoTo Err_cboCountColors
> Dim shp As Shape
> Dim nRed As Long
> Dim nBlue As Long
>
> For Each shp In ActiveSheet.Shapes
> If shp.Name <> "cboCountColors" Then
> Select Case shp.Fill.ForeColor.SchemeColor
> Case 10: nRed = nRed + 1
> Case 12: nBlue = nBlue + 1
> End Select
> End If
> Next shp
>
> Exit_cboCountColors:
> Debug.Print nRed, nBlue
> Exit Sub
> Err_cboCountColors:
> MsgBox Err.Description
> Resume Exit_cboCountColors
> End Sub
>
> This was true with both TakeFocusOnClick set to either True or False.
>
> --
> Regards,
> Tom Ogilvy

Thanks again for your help Tom. I have another question. I have several
buttons I choose to use to change a rectangle to various colors. All of my
buttons begin with "cbo" (something I picked up along the way). I have been
trying to figure out how to use InStr (x,y) to skip shapes beginning with
"cbo" but I can't get the syntax right. Any ideas? I was figuring on "If
Instr(whatever) > 0 Then ... end if"

Again, thank you kindly for your assistance.

Scott

"Tom Ogilvy" <[email protected]> wrote in message
news:[email protected]...
>I see nothing in your code that would relate to the takefocusonclick
> property.
>
> What I found was that the commandbutton caused a permission denied error
> because it doesn't support the properties you are trying to check. If I
> avoided the commandbutton, it worked.
>
> Private Sub cboCountColors_Click()
> On Error GoTo Err_cboCountColors
> Dim shp As Shape
> Dim nRed As Long
> Dim nBlue As Long
>
> For Each shp In ActiveSheet.Shapes
> If shp.Name <> "cboCountColors" Then
> Select Case shp.Fill.ForeColor.SchemeColor
> Case 10: nRed = nRed + 1
> Case 12: nBlue = nBlue + 1
> End Select
> End If
> Next shp
>
> Exit_cboCountColors:
> Debug.Print nRed, nBlue
> Exit Sub
> Err_cboCountColors:
> MsgBox Err.Description
> Resume Exit_cboCountColors
> End Sub
>
> This was true with both TakeFocusOnClick set to either True or False.
>
> --
> Regards,
> Tom Ogilvy

Sorry to the group for double-posting. In any regard, I found what I
needed:

For Each shp in ActiveSheet.Shapes
If InStr(1, shp.Name, "cbo") = 0 Then
---
End if

I use the "If InStr" line in place of the <> "cboCountColors" and I seem to
achieve the same. This also may be a better approach than providing testing
for the several buttons I use.

Again, great thanks for the help.

Scott


"Nimrod" <[email protected]> wrote in message
news:[email protected]...
> Thanks again for your help Tom. I have another question. I have several
> buttons I choose to use to change a rectangle to various colors. All of
> my
> buttons begin with "cbo" (something I picked up along the way). I have
> been
> trying to figure out how to use InStr (x,y) to skip shapes beginning with
> "cbo" but I can't get the syntax right. Any ideas? I was figuring on "If
> Instr(whatever) > 0 Then ... end if"
>

InStr will look anywhere in that string.

cboCountColors
optCxxxcboyyy

You may just want to check the first three characters:

if lcase(left(shp.name)) = "cbo" then
---
end if



Nimrod wrote:
>
> Sorry to the group for double-posting. In any regard, I found what I
> needed:
>
> For Each shp in ActiveSheet.Shapes
> If InStr(1, shp.Name, "cbo") = 0 Then
> ---
> End if
>
> I use the "If InStr" line in place of the <> "cboCountColors" and I seem to
> achieve the same. This also may be a better approach than providing testing
> for the several buttons I use.
>
> Again, great thanks for the help.
>
> Scott
>
> "Nimrod" <[email protected]> wrote in message
> news:[email protected]...
> > Thanks again for your help Tom. I have another question. I have several
> > buttons I choose to use to change a rectangle to various colors. All of
> > my
> > buttons begin with "cbo" (something I picked up along the way). I have
> > been
> > trying to figure out how to use InStr (x,y) to skip shapes beginning with
> > "cbo" but I can't get the syntax right. Any ideas? I was figuring on "If
> > Instr(whatever) > 0 Then ... end if"
> >

--

Dave Peterson

Thanks Dave. I'll implement this. The help is appreciated!

Scott


"Dave Peterson" <[email protected]> wrote in message
news:[email protected]...
> InStr will look anywhere in that string.
>
> cboCountColors
> optCxxxcboyyy
>
> You may just want to check the first three characters:
>
> if lcase(left(shp.name)) = "cbo" then
> ---
> end if
>
>
>
> Nimrod wrote:
>>
>> Sorry to the group for double-posting. In any regard, I found what I
>> needed:
>>
>> For Each shp in ActiveSheet.Shapes
>> If InStr(1, shp.Name, "cbo") = 0 Then
>> ---
>> End if
>>
>> I use the "If InStr" line in place of the <> "cboCountColors" and I seem
>> to
>> achieve the same. This also may be a better approach than providing
>> testing
>> for the several buttons I use.
>>
>> Again, great thanks for the help.
>>
>> Scott
>>
>> "Nimrod" <[email protected]> wrote in message
>> news:[email protected]...
>> > Thanks again for your help Tom. I have another question. I have
>> > several
>> > buttons I choose to use to change a rectangle to various colors. All
>> > of
>> > my
>> > buttons begin with "cbo" (something I picked up along the way). I have
>> > been
>> > trying to figure out how to use InStr (x,y) to skip shapes beginning
>> > with
>> > "cbo" but I can't get the syntax right. Any ideas? I was figuring on
>> > "If
>> > Instr(whatever) > 0 Then ... end if"
>> >
>
> --
>
> Dave Peterson