Sub moveThem()
For i = 3 To 6
Range("A" & i & ":" & Chr(i + 62) & i).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Next
End Sub
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
Sub MoveValuesToDiagonal()
Dim Cell As Range
For Each Cell In Selection
Cell.Cut Cell.Offset(, Cell.Row - Selection(1).Row)
Next
End Sub
Have a look at http://www.mrexcel.com/forum/excel-questions/2270-creating-diagonal-matrix.htmlI 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:
ID# 264 372 521 601 784
<tbody>
</tbody>
to . . .
ID# ID# ID# ID# ID# 264 372 521 601 784
<tbody>
</tbody>
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.
I had figured since the selection could be arbitrary, that there would be no header.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!
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
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