Array Populated with Every Nth Row in a Range

[johnnytominaga]

Hey guys!

I need to copy 1 out of every "n" number of rows up to the end of the table from one worksheet to another.
I've managed to do it with a For Each loop. Using that method takes a while to process all data depending on the number of cells though.

I believe that can be optimized by using an array. Am I right? If so, how can that be accomplished?

I'm working on Excel 2016 on Windows 10.

Thanks a lot,


Johnny

 

[Fluff]

Something like

Sub Myarray()
   Dim Ary As Variant, Nary As Variant
   Dim r As Long, c As Long, rr As Long
   
   Ary = Range("A1").CurrentRegion.Value2
   ReDim Nary(1 To (UBound(Ary) / [COLOR=#ff0000]10[/COLOR]) + 1, 1 To UBound(Ary, 2))
   For r = 1 To UBound(Ary) Step [COLOR=#ff0000]10[/COLOR]
      rr = rr + 1
      For c = 1 To UBound(Ary, 2)
         Nary(rr, c) = Ary(r, c)
      Next c
   Next r
End Sub

The value in red is the nth value

 

[JoeMo]

This version allows the user to select the table range and set the value of N.

Sub EveryNthToArray()
Const N As Long = 6  'Set periodicity here
Dim dataArr As Variant, DataRng As Range, NthArr As Variant, Ct As Long
On Error Resume Next
Set DataRng = Application.InputBox("Select all data rows with your mouse", Type:=8)
On Error GoTo 0
If DataRng Is Nothing Then Exit Sub
dataArr = DataRng.Value
ReDim NthArr(1 To UBound(dataArr, 1))
For i = 1 To UBound(dataArr, 1)
    If i Mod N = 0 Then
        Ct = Ct + 1
        NthArr(Ct) = Application.Index(DataRng, i, 0).Value  'captures every Nth row data in an array element
    End If
Next i
'do something with NthArr
If Ct > 0 Then
    For i = 1 To Ct
        MsgBox Join(Application.Index(NthArr(i), 1, 0), ", ")  'NthArr(i) is 2-D array
    Next i
Else
    MsgBox "Number of rows in your data range is less than N"
End If
End Sub

 

[johnnytominaga]

Thanks a lot for your response JoeMo.
I'm just trying to copy the array values to another worksheet, but no value is being passed on.

Here's what's looking like:
For i = 1 To UBound(dataArr, 1)

If i Mod N = 1 Then
Ct = Ct + 1
NthArr(Ct) = Application.Index(DataRng, i, 0).Value 'captures every Nth row data in an array element
End If

Next i
If Ct > 0 Then
Dim DataSH As Worksheet
Dim DataTarget As Range

Set DataSH = Sheet1
Set DataTarget = DataSH.Range("B9").Resize(Ct, 28)
DataTarget.Value = NthArr
Else
MsgBox "Number of rows in your data range is less than N"

End If


What am I doing wrong?

Thanks again.

This version allows the user to select the table range and set the value of N.

Sub EveryNthToArray()
Const N As Long = 6  'Set periodicity here
Dim dataArr As Variant, DataRng As Range, NthArr As Variant, Ct As Long
On Error Resume Next
Set DataRng = Application.InputBox("Select all data rows with your mouse", Type:=8)
On Error GoTo 0
If DataRng Is Nothing Then Exit Sub
dataArr = DataRng.Value
ReDim NthArr(1 To UBound(dataArr, 1))
For i = 1 To UBound(dataArr, 1)
    If i Mod N = 0 Then
        Ct = Ct + 1
        NthArr(Ct) = Application.Index(DataRng, i, 0).Value  'captures every Nth row data in an array element
    End If
Next i
'do something with NthArr
If Ct > 0 Then
    For i = 1 To Ct
        MsgBox Join(Application.Index(NthArr(i), 1, 0), ", ")  'NthArr(i) is 2-D array
    Next i
Else
    MsgBox "Number of rows in your data range is less than N"
End If
End Sub

 

[JoeMo]

Thanks a lot for your response JoeMo.
I'm just trying to copy the array values to another worksheet, but no value is being passed on.

Here's what's looking like:
For i = 1 To UBound(dataArr, 1)

If i Mod N = 1 Then
Ct = Ct + 1
NthArr(Ct) = Application.Index(DataRng, i, 0).Value 'captures every Nth row data in an array element
End If

Next i
If Ct > 0 Then
Dim DataSH As Worksheet
Dim DataTarget As Range

Set DataSH = Sheet1
Set DataTarget = DataSH.Range("B9").Resize(Ct, 28)
DataTarget.Value = NthArr
Else
MsgBox "Number of rows in your data range is less than N"

End If


What am I doing wrong?

Thanks again.

For one thing, you have changed the code I posted (see bold red above). Here's a version that will print each of the Nth rows (I set N at 10 - change to suit) on sheet1 starting in B9. PLEASE COPY THE CODE DIRECTLY FROM YOUR BROWSER AND PASTE IT TO THE VBE.

Sub EveryNthToArray1()
Const N As Long = 10  'Set periodicity here
Dim DataRng As Range, NthArr As Variant, Ct As Long
On Error Resume Next
Set DataRng = Application.InputBox("Select all data rows with your mouse", Type:=8)
On Error GoTo 0
If DataRng Is Nothing Then Exit Sub
ReDim NthArr(1 To DataRng.Columns.Count)
For i = 1 To DataRng.Rows.Count
    If i Mod N = 0 Then
        Ct = Ct + 1
        NthArr(Ct) = Application.Index(DataRng, i, 0).Value  'captures every Nth row data in an array element
    End If
Next i
'do something with NthArr
If Ct > 0 Then
    Dim DataSH As Worksheet
    Dim DataTarget As Range
    Set DataSH = Sheet1
    For i = 1 To Ct
        Set DataTarget = DataSH.Range("B9").Offset(i - 1, 0).Resize(1, UBound(NthArr))
        DataTarget.Value = NthArr(i)
    Next i
Else
    MsgBox "Number of rows in your data range is less than N"
End If
End Sub