How to shift values in an array by n units in VBA - vba

Question

Suppose I have a column of values
1
2
3
4
5
I'm trying to write a VBA function where based on what number I chose(n)
the cells will loop around to that position. So say I i chose 3
Then new list will be
4
5
1
2
3
What I have done is based on each row number, I have tried to develop rules to move the cells but it doesn't seem to be working.. I suspect it's cause I'm using activerow and not the relative row position, but I'm not sure what the syntax is for relative row. Can someone help me out
Option Explicit
Option Base 1
Function DivisibleByN(rng As Range, n As Integer) As Variant
Dim i As Integer, j As Integer
Dim nr As Integer, nc As Integer
Dim B() As Variant
Dim r As ListRow
nr = rng.Rows.Count
nc = rng.Columns.Count
r = ActiveCell.Row
ReDim B(nr, nc) As Variant
For i = 1 To nr
For j = 1 To nc
If r = 1 And r < n Then
B(nr - (n - 1), j) = rng.Cells(i, j)
ElseIf r > 1 And r < n Then
B(nr - (n - r), j) = rng.Cells(i, j)
ElseIf r > n Then
B(r - n, j) = rng.Cells(i, j)
ElseIf r = n Then
B(r, j) = rng.Cells(i, j)
End If
Next j
Next i
DivisibleByN = B
End Function

Answer 1

Assuming you want to "roll" each column individually, you can do something like this:
Public Sub RollColumns(ByVal rng As Range, ByVal rollBy As Integer)
Dim rowsCount As Integer, colsCount As Integer
Dim rowsOffset As Integer, colsOffset As Integer
Dim r As Integer, c As Integer
rowsCount = rng.Rows.Count
colsCount = rng.Columns.Count
rowsOffset = rng.Rows(1).Row - 1
colsOffset = rng.Columns(1).Column - 1
If rowsCount = 1 Then Exit Sub
Dim arr As Variant
arr = rng.Value
For c = 1 To colsCount
For r = 1 To rowsCount
Dim targetIndex As Integer
targetIndex = (r + rollBy) Mod rowsCount
If targetIndex = 0 Then targetIndex = rowsCount
rng.Worksheet.Cells(r + rowsOffset, c + colsOffset).Value = _
arr(targetIndex, c)
Next r
Next c
End Sub
Usage:
RollColumns Range("A1:C5"), 3
See it in action:

Answer 2

you could use this
Function DivisibleByN(rng As Range, n As Integer) As Variant
Dim i As Long, j As Long
With rng
ReDim B(0 To .Rows.Count - 1, 0 To .Columns.Count - 1) As Variant
For i = .Rows.Count To 1 Step -1
For j = 1 To .Columns.Count
B(i - 1, j - 1) = .Cells((.Rows.Count + i - (n + 1)) Mod .Rows.Count + 1, j)
Next
Next
DivisibleByN = B
End With
End Function

Answer 3

This was just to mess around with COM objects and explore them... could be tidied up. S&G moment.
Option Explicit
Public Sub test()
Const n As Long = 3 '<==Add your end point here
Dim arr(), i As Long, rng As Range
With ThisWorkbook.Worksheets("Sheet6") '<==Put your sheet name here
Set rng = .Range("A1:A5") '<== Add your single column range here
Dim maxValue As Variant
Dim minValue As Variant
maxValue = Application.Max(rng)
minValue = Application.Min(rng)
If IsError(maxValue) Or IsError(minValue) Then Exit Sub
If n > maxValue Or n < minValue Then Exit Sub
If rng.Columns.Count > 1 Then Exit Sub
If rng.Cells.Count = 1 Then
ReDim arr(1, 1): arr(1, 1) = rng.Value
Else
arr = rng.Value
End If
Dim list As Object, list2 As Object, queue As Object, arr2()
Set list = CreateObject("System.Collections.ArrayList")
Set queue = CreateObject("System.Collections.Queue")
For i = LBound(arr, 1) To UBound(arr, 1)
list.Add arr(i, 1)
Next
list.Sort
Set list2 = list.Clone
list2.Clear
arr2 = list.GetRange(n, maxValue - n).toArray
For i = LBound(arr2) To UBound(arr2)
queue.enqueue arr2(i)
Next
list2.addRange queue
queue.Clear
arr2 = list.GetRange(0, n).toArray
For i = LBound(arr2) To UBound(arr2)
queue.enqueue arr2(i)
Next
list2.addRange queue
rng.Cells(1, 1).Resize(list2.Count, 1) = Application.WorksheetFunction.Transpose(list2.toArray)
End With
End Sub