Moving each subsequent row over one column

[LAAdams17]

I would like to take a column of data (numbers or text) so I can use it for an Advanced Search Criteria and change it from:

[TABLE="class: cms_table, width: 64"]
<tbody>[TR]
[TD]ID#[/TD]
[/TR]
[TR]
[TD]264[/TD]
[/TR]
[TR]
[TD]372[/TD]
[/TR]
[TR]
[TD]521[/TD]
[/TR]
[TR]
[TD]601[/TD]
[/TR]
[TR]
[TD]784[/TD]
[/TR]
</tbody>[/TABLE]


to . . .

[TABLE="class: cms_table, width: 320"]
<tbody>[TR]
[TD]ID#[/TD]
[TD]ID#[/TD]
[TD]ID#[/TD]
[TD]ID#[/TD]
[TD]ID#[/TD]
[/TR]
[TR]
[TD]264[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]372[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]521[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]601[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]784[/TD]
[/TR]
</tbody>[/TABLE]

 

[Gary's Student]

How about:

Sub moveThem()
For i = 3 To 6
Range("A" & i & ":" & Chr(i + 62) & i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next
End Sub

 

[LAAdams17]

That's very helpful; thank you.

Do know how to do this based on the current selection regardless of the location in the spreadsheet or the number of cells selected (in this example there were 6 including the header row, but there may be 10 or 50 or ???)? One other thing I'm looking to automate (but it's not nearly as important as the above) is to extend the header/title (in the original example, "ID#") across the number of columns based on the number of rows selected (as illustrated in the original example).

Again, many thanks!

 

[Gary's Student]

Say a column has values. Hi-light that part of the column you want to extend out and run this:

Sub moveThem2()
Dim r As Range, i As Long, j As Long
i = 1
For Each r In Selection
    For j = 1 To i
        r.Insert shift:=xlToRight
    Next j
    i = i + 1
Next r
End Sub

 

[Rick Rothstein]

Here is another way to do it...

Sub MoveValuesToDiagonal()
  Dim Cell As Range
  For Each Cell In Selection
    Cell.Cut Cell.Offset(, Cell.Row - Selection(1).Row)
  Next
End Sub

 

[mirabeau]

I would like to take a column of data (numbers or text) so I can use it for an Advanced Search Criteria and change it from:

[TABLE="class: cms_table, width: 64"]
<tbody>[TR]
[TD]ID#[/TD]
[/TR]
[TR]
[TD]264[/TD]
[/TR]
[TR]
[TD]372[/TD]
[/TR]
[TR]
[TD]521[/TD]
[/TR]
[TR]
[TD]601[/TD]
[/TR]
[TR]
[TD]784[/TD]
[/TR]
</tbody>[/TABLE]


to . . .

[TABLE="class: cms_table, width: 320"]
<tbody>[TR]
[TD]ID#[/TD]
[TD]ID#[/TD]
[TD]ID#[/TD]
[TD]ID#[/TD]
[TD]ID#[/TD]
[/TR]
[TR]
[TD]264[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]372[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD]521[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]601[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]784[/TD]
[/TR]
</tbody>[/TABLE]

Have a look at http://www.mrexcel.com/forum/excel-questions/2270-creating-diagonal-matrix.html

 

[L. Howard]

Try any or all of these, I believe they do what you want.

Regards,
Howard

Code cLant is my attempt, but is hard coded to a specific column.
Code cLantx & cLantxx are my attempts tweeked by Joeu2004.

Option Explicit

Sub cLant()
Dim c As Range
Dim i As Long
Dim rCt As Range
Set rCt = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row)
i = 0
  For Each c In rCt
    c.Cut c.Offset(, i)
    Range("A1").Copy Range("A1").Offset(, i)
    i = i + 1
  Next
  
End Sub

'Following Tweeked by Joeu2004

Sub cLant() 
Dim c As Range 
Dim i As Long 
Dim rCt As Range, sel As Range 

Set sel = Selection(1) 
Set rCt = Range(sel.Offset(1), Cells(Rows.Count, sel.Column).End(xlUp)) 
i = 0 
For Each c In rCt 

    c.Cut c.Offset(0, i) 
    sel.Copy sel.Offset(0, i) 
    i = i + 1 
Next 
End Sub 


'That assumes the user selects at least the header cell. 

Sub cLant() 
Dim c As Range 
Dim i As Long 

Dim rCt As Range, sel As Range 
Dim h As Variant 

Set sel = Selection(1) 
Set rCt = Range(sel.Offset(2), Cells(Rows.Count, sel.Column).End(xlUp)) 
i = 1 
h = sel.Formula 
For Each c In rCt 

    c.Offset(0, i).Formula = c.Formula 
    c.Clear 
    sel.Offset(0, i).Formula = h 
    i = i + 1 
Next 
End Sub 



Assumptions: 

1. There are at least 2 cells under the header to be moved across. 

2. The header cell and subsequent cells can contain formulas or constant 
values.

 

[LAAdams17]

Rick, I really appreciate your code; it works perfectly. One other part I was looking to automate (but it's not nearly as important as the above) is to extend the header/title ("ID#" as illustrated in the example of the original post) across the number of columns based on the number of rows selected. Thank you again!

 

[Rick Rothstein]

Rick, I really appreciate your code; it works perfectly. One other part I was looking to automate (but it's not nearly as important as the above) is to extend the header/title ("ID#" as illustrated in the example of the original post) across the number of columns based on the number of rows selected. Thank you again!

I had figured since the selection could be arbitrary, that there would be no header.

Anyway, assuming the header cell is not part of the selection, we just need to add the line of code delineated in red...

Sub MoveValuesToDiagonal()
  Dim Cell As Range
  Selection(1).Offset(-1).Resize(, Selection.Count).Value = Selection(1).Offset(-1).Value
  For Each Cell In Selection
    Cell.Cut Cell.Offset(, Cell.Row - Selection(1).Row)
  Next
End Sub

If the header will be part of the selection, then use this modified code instead...

Sub MoveValuesToDiagonal()
  Dim Cell As Range
  Selection(1).Resize(, Selection.Count).Value = Selection(1).Value
  For Each Cell In Selection(1).Offset(1).Resize(Selection.Count - 1)
    Cell.Cut Cell.Offset(, Cell.Row - Selection(1).Offset(1).Row + 1)
  Next
End Sub

 

[LAAdams17]

You nailed it. THANK YOU!