CODEWITHSUNDEEP
vba
Dhruv Alexander
Dhruv Alexander

Reputation: 23

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

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

Upvotes: 0

Views: 188

Answers (3)

QHarr
QHarr

Reputation: 84465

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

Upvotes: 0

DisplayName
DisplayName

Reputation: 13386

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

Upvotes: 0

41686d6564
41686d6564

Reputation: 19641

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:

RollColumns

Upvotes: 1

Related Questions