PDA

View Full Version : Need Help with a Looping Issue



Smoke0101
08-08-2013, 08:09 AM
Hi guys, I am new to VBA and looking for a little help with what I think is a loop issue

So I am trying to create a VBA macro to run through and count the number of cells that contain a certain text (in this case Weapon), and also have the color green in them. My problem is that it doesnt like me and gives me an error.

So I am wondering if someone who is a little more experiences might have a better Idea. Thanks!

The Function is called ColorCount and passes a cell range, text, and then a single cell. The code is below the picture.
10393
Function ColorCount(rRange As Range, Asignee As String, cCol As Range)


Dim AsigTr As Double
Dim WhatColor As Double
Dim tempRes As Double
Dim rCell As Range
Dim Marker As Long


Marker = cCol.Interior.ColorIndex
tempRes = 0


For Each rCell In rRange
AsigTr = WorksheetFunction.Search(Asignee, rCell)
If AsigTr = 1 Then
WhatColor = rCell.Interior.ColorIndex
If WhatColor = Marker Then
tempRes = 1 + tempRes
End If
End If
Next rCell


ColorCount = tempRes


End Function

Kenneth Hobs
08-08-2013, 08:35 AM
<p>
Welcome to the forum!</p>
<p>
Note that the code will not check interior colors set by conditional formatting. Change your code to check the Value property of rCell in the loop rather than a Find routine.</p>
<p>
Here are multi-find routines that you might like: http://www.cpearson.com/excel/FindAll.aspx http://www.vbaexpress.com/forum/showthread.php?t=38802</p>

SamT
08-08-2013, 02:26 PM
Function ColorCount(rRange As Range, Asignee As String, cCol As Range)

Dim rCell As Range
Dim Marker As Long
Dim tempRes As Long

Marker = cCol.Interior.ColorIndex

For Each rCell In rRange
If rCell = Assignee And _
rCel.Interior.ColorIndex = Marker _
Then tempRes = tempRes + 1
Next rCell

ColorCount = tempRes
End Function

Smoke0101
08-12-2013, 05:37 AM
Function ColorCount(rRange As Range, Asignee As String, cCol As Range)

Dim rCell As Range
Dim Marker As Long
Dim tempRes As Long

Marker = cCol.Interior.ColorIndex

For Each rCell In rRange
If rCell = Assignee And _
rCel.Interior.ColorIndex = Marker _
Then tempRes = tempRes + 1
Next rCell

ColorCount = tempRes
End Function

I wanted to thank both Mr Hobs, and SamT for your help. SamT your code didn't quite work so I rewrote mine using some of the ways you did and was able to get it working. It is not the cleanest code as of yet but for my purposes it works and thats all I care about.



Function ColorCount(rRange As Range, Asignee As String, cCol As Range)

Dim tempRes As Double
Dim rCell As Range
Dim Marker As Double

Marker = cCol.Interior.ColorIndex

For Each rCell In rRange
If rCell = Asignee Then
If rCell.Interior.ColorIndex = Marker Then
tempRes = tempRes + 1
Else
tempRes = tempRes + 0
End If
Else
tempRes = tempRes + 0
End If
Next rCell

ColorCount = tempRes

End Function

SamT
08-12-2013, 11:35 AM
I gotta admit that I'm stumped. I can't see any logical difference between yours' and my code. But if it works...Or doesn't.

All that matters is that you have working code :)