Array Populated with Every Nth Row in a Range

johnnytominaga

New Member
Joined
Apr 27, 2018
Messages
19
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
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Something like
Code:
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
 
Upvote 0
This version allows the user to select the table range and set the value of N.
Code:
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
 
Upvote 0
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.
Code:
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
 
Upvote 0
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.
Code:
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
 
Upvote 0

Forum statistics

Threads
1,223,884
Messages
6,175,177
Members
452,615
Latest member
bogeys2birdies

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top