loop thru cells in current row

[davidmyers]

Hi, Need a little guidance (or was that gui dance?)

I'm trying to check the font color of each of each cell in the current row, not sure how to do it, this is what I have so far - I'm getting an error of Type mismatch on the range

Sub KeepRed(defaultcolor)
Dim rng As Range, cell As Range
Set rng = ActiveCell.Row
   For Each cell In rng
       If Not (cell.Font.ColorIndex = 3) Then
           cell.Font.ColorIndex = defaultcolor
       End If
   Next cell
End Sub

Don't know if I need a range to loop thru current row?

Any help appreciated
David

 

[dmt32]

Hi,
try changing this line

Set rng = ActiveCell.Row

for this

Set rng = Rows(ActiveCell.Row)

and see if this resolves the error

Dave

 

[Fluff]

Try

Sub KeepRed(defaultcolor)
Dim rng As Range, cell As Range
Set rng = Intersect(activecell.EntireRow, ActiveSheet.UsedRange)
   For Each cell In rng
       If Not (cell.Font.ColorIndex = 3) Then
           cell.Font.ColorIndex = defaultcolor
       End If
   Next cell
End Sub

 

[davidmyers]

Thanks for your quick responses, I used Fluff's solution 'caused it solved another issue I was having which was it took time to execute - blue circle for a few seconds whenever I activated the code - with Fluffs code it's instantaneous.

Thanks all, much appriciated
David

 

[Fluff]

Glad we could help & thanks for the feedback