Select every nth row in filtered range

[neqkeet]

Hi everyone.

I need to select every 2nd row in filered table. For example, if visible rows are as in the table below, i need to select 5th, 10th and 19th. Thx for your help

*Row number*	*Column A Header
2
5
8
10
15
19
25

<tbody>
</tbody>

Sub Eeeeeee()Dim rng As Range
Dim InputRng As Range
Dim InputRngArea As Range
Dim OutRng As Range
Dim xInterval As Integer
Set InputRng = Range("C1:C200")
xInterval = 2
For i = 2 To InputRng.Rows.Count Step xInterval
    Set rng = InputRng.Cells(i, 1)
    If OutRng Is Nothing Then
        Set OutRng = rng
    Else
        Set OutRng = Application.Union(OutRng, rng)
    End If
Next
OutRng.EntireRow.Select
End Sub

 

[Peter_SSs]

What are you going to do with them after selecting?
I ask because you rarely need to actually select cells/ranges to work with them and selecting can slow your code considerably.

 

[neqkeet]

What are you going to do with them after selecting?
I ask because you rarely need to actually select cells/ranges to work with them and selecting can slow your code considerably.

Going to delete them. But i prefer to select them first, to be sure that code worked correctly. However if selecting will slow the code, it is better to highlight them.

 

[Fluff]

How about

Sub Eeeeeee()

    Dim Chk As Boolean
    Dim OutRng As Range
    Dim Cnt As Long
    
    For Cnt = 2 To 2000
        If Not Rows(Cnt).Hidden Then
            If Not Chk Then
                If OutRng Is Nothing Then
                    Set OutRng = Range("A" & Cnt)
                Else
                    Set OutRng = Union(OutRng, Range("A" & Cnt))
                End If
                Chk = True
            Else
                Chk = False
            End If
        End If
    Next
    OutRng.EntireRow.Interior.Color = vbRed

End Sub

 

[Peter_SSs]

Another option, just dealing with the visible rows:

Sub EveryNth()
  Dim InputRng As Range, OutRng As Range, VisRng As Range, c As Range
  Dim i As Long
  
  Const xInterval As Long = 2
  
  Set InputRng = Range("C1:C200")
  Set VisRng = InputRng.SpecialCells(xlVisible)
  If VisRng.Cells.Count > 1 Then
    Set OutRng = InputRng.Cells(1)
    i = -1
    For Each c In VisRng
      i = i + 1
      If i Mod xInterval = 0 Then Set OutRng = Union(OutRng, c)
    Next c
  End If
  Set OutRng = Intersect(OutRng, InputRng.Offset(1))
  OutRng.EntireRow.Interior.Color = vbYellow
End Sub