Excel VBA - color/shade alternating rows in filtered list

[robertvdb]

I have a filtered list, and I need to shade the alternating rows in this list.

Can anyone help in VBA ?

Thanks in advance.

 

[footoo]

Any reason you need to do with VBA?
Can be done with conditional formatting - easily available on the internet.

 

[robertvdb]

Thanks footoo, but it's part of a 100% VBA project, so I need the VBA. The end user is not able to apply conditional formatting.

 

[footoo]

Sub vv()
With Intersect(Range("A1:A" & Cells(Rows.Count, 1).End(3).Row).EntireRow, ActiveSheet.UsedRange)
    .FormatConditions.Delete
    .FormatConditions.Add Type:=xlExpression, Formula1:="=MOD(SUBTOTAL(3,$A$1:$A1),2)=0"
    .FormatConditions(1).Interior.ColorIndex = 37
End With
End Sub

Above assumes there are no blank cells in column A.

 

[robertvdb]

Thanks footoo but this will not work, since the row numbers are not a natural serie 1,2,3,4,5 etc.

What I need is kind of a loop which starts at the first row, then shades this first row, then shades the row 2 lines below, etc until the last row.

 

[footoo]

Thanks footoo but this will not work, since the row numbers are not a natural serie 1,2,3,4,5 etc.

The row numbers are irrelevant.
The only caveat : there must be no blanks in column A.
Why don't you try it?

 

[robertvdb]

Thanks ! this seems to work. All I still want to do is to better define the range --> from the top row until the last row.

 

[footoo]

All I still want to do is to better define the range --> from the top row until the last row.

That is what the code does based on column A.
Is there a problem?

If the code is based on a loop, it would probably be quite slow :

Sub v()
Dim rng As Range, lc&, x&, cel As Range
Set rng = Range("A2:A" & Cells(Rows.Count, 1).End(3).Row).SpecialCells(xlCellTypeVisible)
Cells.Interior.ColorIndex = xlNone
lc = Cells(1, Columns.Count).End(xlToLeft).Column
x = 1
For Each cel In rng
    If x Mod 2 = 0 Then Range(cel, Cells(cel.Row, lc)).Interior.ColorIndex = 37
    x = x + 1
Next
End Sub

 

[robertvdb]

Thanks footoo ! Problem solved. I appreciate your assistance.