0

I need an array function that will shift up a vector at rng range by n cells. Here is my code so far:

Option Explicit
Option Base 1

Function ShiftVector(rng As Range, n As Integer)
Dim nr As Integer
Dim i As Integer
Dim head() As Variant
Dim tail() As Variant
Dim shift() As Variant

nr = rng.Rows.Count
ReDim head(n)

For i = 1 To n
        head(i) = rng(i).Value
    Next i

ReDim tail(nr - n)

For i = 1 To nr - n
        tail(i) = rng(n + i).Value
    Next i

ReDim shift(nr)

For i = 1 To nr - n
        shift(i) = tail(i)
    Next i

For i = (nr - n + 1) To nr
        shift(i) = head(i - (nr - n))
    Next i

ShiftVector = shift()

End Function

I have tested running this as a subroutine and saw that in the locals window the new array "shift()" had the values I needed, however I am having trouble outputting the new array as a function in a new location show below:

How I want to output the new shifted array

1 Answer 1

1

When dealing with Ranges its easiest to work 2D Arrays. Also, your logic can be simplified quite a bit.

Function ShiftVector(rng As Range, n As Long)
    Dim i As Long
    Dim shift() As Variant
    Dim dat As Variant

    ReDim shift(1 To rng.Rows.Count, 1 To 1)
    dat = rng.Value 'this will speed up the UDF on larger ranges

    For i = 1 To n
        shift(i, 1) = dat(i + n, 1)
    Next i
    For i = n + 1 To rng.Rows.Count
        shift(i, 1) = dat(i - n, 1)
    Next i

    ShiftVector = shift()
End Function

I'd also suggest adding some range checks on n and size/shape checks on rng

FWIW your code could be fixed by changing the last line to ShiftVector = Application.Transpose(shift())

Sign up to request clarification or add additional context in comments.

Comments

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.