Rotate cells in a two column range

[johnbird1988]

Hello

I would like some help in rotating some numbers within two column.

My data looks like the below.

A B
1 1 2
2 3 4
3 5 6

For this example I have used 1 to 6. However it will always start with 1 but the maximum number will be different but always even. What I would like to do is create a loop that will rotate the numbers clockwise. So by running the code it will look like this

A B
1 3 1
2 5 2
3 6 4

And if I was to run the code again I would get:

A B
1 5 3
2 6 1
3 4 2

And so on.

I am a bit stuck on how I can achieve this given the numbers will change each time

Please any help will be appreciative.

Thank you,

John

 

[bhos123]

Sub Macro6()
Dim Lastrow As Long
Application.ScreenUpdating = False
Range("B2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A2").Select
Selection.Cut Destination:=Range("B2")
With ActiveSheet
Lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
Range("B" & Lastrow).Select
Selection.Cut Destination:=Range("A" & Lastrow)
Range("A2").Select
Selection.Delete Shift:=xlUp
Application.ScreenUpdating = True

End Sub

Assuming you have Column headers on row 1

 

[MickG]

Another option :-

[COLOR="Navy"]Sub[/COLOR] MG13Jul14
[COLOR="Navy"]Dim[/COLOR] Lst [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer,[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
Lst = Range("A" & Rows.Count).End(xlUp).Row
Temp = Cells(1, 1)
Cells(1, 1).Delete
Cells(1, 2).Insert
Cells(1, 2) = Temp
Cells(Lst, 1) = Cells(Lst + 1, 2)
Cells(Lst + 1, 2) = ""

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[Jonmo1]

Try this.
The only adjustment you need to make is to set the top left cell of the range you want to rotate.
It assumes 2 columns, and no 'unrelated' values below the end of the range to rotate.

Sub Rotate()
Dim MyRange As Range, FirstCell As Range
Dim ar(), ar2(), lr As Long, r As Long

Set FirstCell = Range("C8") '<-- The Top Left Cell of the Range to Rotate
lr = FirstCell.End(xlDown).Row
Set MyRange = FirstCell.Resize(lr - FirstCell.Row + 1, 2)
ar2() = MyRange.Value
ReDim Preserve ar(1 To UBound(ar2), 1 To 2)

ar(UBound(ar2), 1) = ar2(UBound(ar2), 2)

For r = 2 To UBound(ar2)
    ar(r - 1, 1) = ar2(r, 1)
    ar(r, 2) = ar2(r - 1, 2)
Next r

ar(1, 2) = ar2(1, 1)

MyRange = ar
End Sub