Tom,

I spoke too soon........your solution did resolve the immediate issue if one
cell was highlighted and the other not. The code does not work if instead of
two like amounts if one is different then the code does not see any amounts.
If there are three like amounts then I'm back to where I started except now
the code finds 6 instances and so on and so forth.
I may have to come up with another means to be able to get the desired
results but any help or pointers will be appreciated.

Carl Morgan


"Tom Ogilvy" wrote in message
.. .
Maybe something like this:

Sub ABC()
For Each c In ActiveSheet.Range("addon")
If c.Interior.ColorIndex < 6 Then

MyArr = Array(c.Value)

'Rcount = 0
With ActiveSheet.Range("addon")
'note - addon is a range created with union

For I = LBound(MyArr) To UBound(MyArr)
Set rng = .Find(What:=MyArr(I), _
After:=c, _
LookIn:=xlValues)
If rng.Address < c.Address Then
If Not rng Is Nothing Then
FirstAddress = rng.Address
Do
If rng.Address < c.Address Then
Rcount = Rcount + 1
ActiveSheet.Range("B" & Rcount).Value = rng.Value
End If
Set rng = .FindNext(rng)
Loop While Not rng Is Nothing And rng.Address <
FirstAddress
'ActiveSheet.Range("w1") = Rng.Address
End If
End If
Next I

End With
'Application.ScreenUpdating = True
End If
Next c

End Sub

--
Regards,
Tom Ogilvy


"carlos" wrote in message
...
I am working with a home-grown budget project and I have a problem with a
bit of the code. I am attempting to justify a balance based on
transactions
that have cleared versus pending transactions. I am setting the cell
interior.colorindex to highlight the amounts which have cleared. The
problem
that I am having is that within a rangI have two transactions that are
exactly the same amount, one which has cleared and one that is pending.
When
I run my code it ignores the colorindex property and adds both amounts.
If
I
change one of the entries the code works just fine.

Please, any help or pointers would be appreciated.

For Each c In ActiveSheet.Range("addon")
If c.Interior.ColorIndex < 6 Then

MyArr = Array(c.Value)

'Rcount = 0
With ActiveSheet.Range("addon")
'note - addon is a range created with union

For I = LBound(MyArr) To UBound(MyArr)
Set Rng = .find(What:=MyArr(I), _
LookIn:=xlValues)
If Not Rng Is Nothing Then
FirstAddress = Rng.Address
Do
Rcount = Rcount + 1
ActiveSheet.Range("Z" & Rcount).Value = Rng.Value
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <
FirstAddress
'ActiveSheet.Range("w1") = Rng.Address
End If
Next I
End With
'Application.ScreenUpdating = True
End If
Next c