Shif cells to the right and down within limits

[LuisE]

I have sets of data in blocks of three vertical cells (A1:A3, B1:B3, C1:C3,
A4:A6, B4:B6...................). I need to shift them as many blocks as the
user indicated starting from left to right and then when column C is reched
downbelow to the nex available row, something like this
123
456
789
would look like this if shifted two blocks
1
234
567
89

Thanks in advance

----------------
This post is a suggestion for Microsoft, and Microsoft responds to the
suggestions with the most votes. To vote for this suggestion, click the "I
Agree" button in the message pane. If you do not see the button, follow this
link to open the suggestion in the Microsoft Web-based Newsreader and then
click "I Agree" in the message pane.

http://www.microsoft.com/office/com...7c322bd&dg=microsoft.public.excel.programming

 

[Dave Peterson]

Maybe...

Option Explicit
Sub testme()

Dim MaxShift As Long 'stop the user from shifting too many
Dim HowManyCellsToShift As Long 'The user's response
Dim HowManyColsInData As Long '3 columns in your sample data

Dim myRng As Range
Dim myRow As Range
Dim myCell As Range
Dim oCol As Long
Dim oRow As Long

HowManyCellsToShift = CLng(Application.InputBox(Prompt:="How many", _
Type:=1))

MaxShift = 22
HowManyColsInData = 3

'minor validation
If HowManyCellsToShift < 1 Then
Exit Sub
End If

If HowManyCellsToShift > MaxShift Then
Exit Sub
End If

With Worksheets("Sheet1")
Set myRng = .Range("a1:C" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

With Worksheets.Add
oRow = (HowManyCellsToShift \ HowManyColsInData) + 1
oCol = HowManyCellsToShift - ((oRow - 1) * HowManyColsInData) + 1
For Each myRow In myRng.Rows
For Each myCell In myRow.Cells
.Cells(oRow, oCol).Value = myCell.Value
If oCol >= HowManyColsInData Then
oCol = 1
oRow = oRow + 1
Else
oCol = oCol + 1
End If
Next myCell
Next myRow
End With
End Sub

 

[LuisE]

Dave, right on, thank you very much

Maybe...

Option Explicit
Sub testme()

Dim MaxShift As Long 'stop the user from shifting too many
Dim HowManyCellsToShift As Long 'The user's response
Dim HowManyColsInData As Long '3 columns in your sample data

Dim myRng As Range
Dim myRow As Range
Dim myCell As Range
Dim oCol As Long
Dim oRow As Long

HowManyCellsToShift = CLng(Application.InputBox(Prompt:="How many", _
Type:=1))

MaxShift = 22
HowManyColsInData = 3

'minor validation
If HowManyCellsToShift < 1 Then
Exit Sub
End If

If HowManyCellsToShift > MaxShift Then
Exit Sub
End If

With Worksheets("Sheet1")
Set myRng = .Range("a1:C" & .Cells(.Rows.Count, "A").End(xlUp).Row)
End With

With Worksheets.Add
oRow = (HowManyCellsToShift \ HowManyColsInData) + 1
oCol = HowManyCellsToShift - ((oRow - 1) * HowManyColsInData) + 1
For Each myRow In myRng.Rows
For Each myCell In myRow.Cells
.Cells(oRow, oCol).Value = myCell.Value
If oCol >= HowManyColsInData Then
oCol = 1
oRow = oRow + 1
Else
oCol = oCol + 1
End If
Next myCell
Next myRow
End With
End Sub

 

[LuisE]

Dave,
Sorry to bother. I forgot to mention that the cells have to be moved in
blocks of three vertical cells at the time, Row1 corresponds to name Row2 is
a code associated to it and and Row3 another code linked to the two rows
above.

I've been trying to apply extend your code to that concept but I can't get
it to work.
Any further help would be greatly appreciated.
Thanks
Luis

 

[Dave Peterson]

I don't understand what you mean.

Maybe you could share some examples.

 

[LuisE]

Dave,
Let's assume this is my set of data

A1: Red B1: Blue C1: Pink
A2: Red B2: Blue C2: Pink
A3: Red B3: Blue C3: Pink
A4: Black B1: White C4: Yellow
A5: Black B1: White C5: Yellow
A6: Black B1: White C6: Yellow

And if I choose to shift 1 (block of data) it'll look like this

B1: Red C1: Blue
B2: Red C2: Blue
B3: Red C3: Blue
A4: Pink B4: Black C4: White
A5: Pink B5: Black C5: White
A6: Pink B6: Black C6: White
A7: Yellow
A8: Yellow
A9: Yellow

 

[Dave Peterson]

Lightly tested:

Option Explicit
Sub testme()

Dim MaxShift As Long 'stop the user from shifting too many
Dim HowManyCellsToShift As Long 'The user's response
Dim HowManyColsInData As Long '3 columns in your sample data

Dim myRng As Range
Dim myRow As Range
Dim myCell As Range
Dim iRow As Long
Dim LastRow As Long
Dim oCol As Long
Dim oRow As Long

HowManyCellsToShift = CLng(Application.InputBox(Prompt:="How many", _
Type:=1))

MaxShift = 22
HowManyColsInData = 3

'minor validation
If HowManyCellsToShift < 1 Then
Exit Sub
End If

If HowManyCellsToShift > MaxShift Then
Exit Sub
End If

With Worksheets("Sheet1")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set myRng = .Range("a1:C" & LastRow)
End With

With Worksheets.Add
oRow = (HowManyCellsToShift \ HowManyColsInData) + 1
oCol = HowManyCellsToShift - ((oRow - 1) * HowManyColsInData) + 1
For iRow = 1 To LastRow Step 3
For Each myCell In myRng.Rows(iRow).Cells
.Cells(oRow, oCol).Resize(3, 1).Value _
= myCell.Resize(3, 1).Value
If oCol >= HowManyColsInData Then
oCol = 1
oRow = oRow + 3
Else
oCol = oCol + 1
End If
Next myCell
Next iRow
End With
End Sub

 

[LuisE]

Thank you very much Dave, what a master piece. It is greatly appreciated.

I just added the following code at the end in order to keep the 3 row blocks.

If HowManyCellsToShift > 2 Then
Range("A1:A" & (HowManyCellsToShift \ 3) * 2).Rows.EntireRow.Insert
End If


Thanks again for your time and help

 

[Dave Peterson]

Glad you got it working.

Instead of inserting new rows in that empty worksheet, I tried to make sure I
was on the row I wanted.

If you wanted, you could fiddle with this line:

oRow = (HowManyCellsToShift \ HowManyColsInData) + 1

But I'll leave that to you <bg>.