Solved: Shifting cells to the right????

[twelvety]

Hi,

I need to shift entire rows a certain number of cells to the right. It would work so that in every block of 10 ten rows they would move.

row1 - one to the right
row2 - two to the right
row3 - three to the right
row4 - four to the right
row5 - five to the right
row6 - four to the right
row7 - three to the right
row8 - two to the right
row9 - one to the right
row10 - no change

Is anyone able to offer up the code to do this?

Thank you

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim LastRow As Long
Dim ShiftNum As Long
Dim i As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

ShiftNum = i Mod 10
If ShiftNum > 0 Then .Cells(i, TEST_COLUMN).Resize(, ShiftNum).Insert shift:=xlToRight
Next i
End With
End Sub
[/vba]

[twelvety]

Rows 6-9 need to shift less to the right than that. ie,

Row 6 only shifts 4 to the right,
Row 7 only shifts 3 to the right,
Row 8 only shifts 2 to the right,
Row 9 only shifts 1 to the right,
Row 10 no change.

Thanks in advance

[Bob Phillips]

[vba]

Public Sub ProcessData()
Const TEST_COLUMN As String = "A" '<=== change to suit
Dim LastRow As Long
Dim ShiftNum5 As Long
Dim ShiftNum10 As Long
Dim ShiftNum As Long
Dim i As Long

With ActiveSheet

LastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
For i = 1 To LastRow

ShiftNum10 = i Mod 10
If ShiftNum10 > 0 Then

ShiftNum = ShiftNum10
ShiftNum5 = i Mod 5
If ShiftNum > 5 Then

If ShiftNum5 <> ShiftNum10 Then

ShiftNum = 5 - ShiftNum5
End If
End If

.Cells(i, TEST_COLUMN).Resize(, ShiftNum).Insert shift:=xlToRight
End If
Next i
End With
End Sub
[/vba]