ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   VBA code to count colors/shapes? (https://www.excelbanter.com/excel-programming/328722-vba-code-count-colors-shapes.html)

Nimrod[_2_]

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?



Bob Phillips[_7_]

VBA code to count colors/shapes?
 
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" wrote in message
...
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?





Nimrod[_2_]

VBA code to count colors/shapes?
 
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" wrote in message
...
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" wrote in message
...
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 Phillips[_7_]

VBA code to count colors/shapes?
 
What Excel version?

--
HTH

Bob Phillips

"Nimrod" wrote in message
...
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" wrote in message
...
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" wrote in message
...
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?









Scott B

VBA code to count colors/shapes?
 
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" wrote in message
...
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.




Nimrod[_2_]

Bug in VBA code to count colors/shapes
 
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



Nimrod[_2_]

Bug in VBA code to count colors/shapes
 
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" wrote in message
...
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





Tom Ogilvy

Bug in VBA code to count colors/shapes
 
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" wrote in message
...
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" wrote in message
...
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







Nimrod[_2_]

Bug in VBA code to count colors/shapes
 
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" wrote in message
...
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[_2_]

Bug in VBA code to count colors/shapes
 
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" wrote in message
...
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[_2_]

Bug in VBA code to count colors/shapes
 
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" wrote in message
...
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[_5_]

Bug in VBA code to count colors/shapes
 
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" wrote in message
...
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

Scott B

Bug in VBA code to count colors/shapes
 
Thanks Dave. I'll implement this. The help is appreciated!

Scott


"Dave Peterson" wrote in message
...
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" wrote in message
...
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





All times are GMT +1. The time now is 10:38 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com