The code as is works in most situations however sometimes when a bar slightly over laps it will count in the range and sometimes I can't get it out of the range. This code is going into a document that I don't use it's used by other people who produce a schedule and for whatever reason they have used shapes as their people to overlay on a time sheet. Thank you to everyone who looks at this and give feedback or input. I'm trying to come up with solutions that don't require new training. I think the solution is out there, but I get hung up on the syntax of VBA coding.
Regards
G
Code below
Regards
G
Code below
Code:
Function CountShapes(rngSearch As Range) As Long
Dim sh As Shape
'will count +1 each shape that isn't blue in the current range (I.E. =CountShapes(A1:10)
For Each sh In rngSearch.Parent.Shapes
If Not Intersect(rngSearch, Range(sh.TopLeftCell, sh.BottomRightCell)) Is Nothing Then
If Not sh.Fill.ForeColor.RGB = RGB(91,155,213) Then CountShapes = CountShapes + 1
End If
Next sh
'will count -1 each shape that is blue in the current range to minus out the bar under the blue one (I.E. =CountShapes(A1:10)
For Each sh In rngSearch.Parent.Shapes
If Not Intersect(rngSearch, Range(sh.TopLeftCell, sh.BottomRightCell)) Is Nothing Then
If sh.Fill.ForeColor.RGB = RGB(91,155,213) Then CountShapes = CountShapes - 1
End If
Next sh
'will count -1 each shape that is a blue line in the current range (I.E. =CountShapes(A1:10)
For Each sh In rngSearch.Parent.Shapes
If Not Intersect(rngSearch, Range(sh.TopLeftCell, sh.BottomRightCell)) Is Nothing Then
If sh.Line.ForeColor.RGB = RGB(0,0,255) Then CountShapes = CountShapes - 1
End If
Next sh
'this part of the code doesn't work, I can't figure it out. But in theory it should try to look at the width of the shape in the range and subtract one from it.
For Each sh In rngSearch.Parent.Shapes
If Not Intersect(rngSearch, Range(sh.TopLeftCell, sh.BottomRightCell)) Is Nothing Then
If sh.ShapeRange.ScaleWidth < 0.9743589494 Then CountShapes = CountShapes - 1
End If
Next sh
End Function
