Adjust code to run anywhere on sheet

[Howard]

This code works fine on a list with a Header in column A.
Copies the Header across the same row, starting 1 column to the right for as many columns as there are items in the list.
Cuts the items in the list to the right on a "slant" 1 column over and 1 row down until end of list.

So now the OP says the list will not always be in the same range but wants the code to do as it does here as I have posted. The lists to processed will be in different columns and not always starting at row 1.

I tried using 'For Each c In Selection' but I cannot figure out how to identify the header in the Selection to copy across as needed.

Thanks.
Howard

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

[Howard]

Small correction:

<Copies the Header across the same row, starting 1 column to the right for as many columns as there are items in the list.>

Actually, if list starts in A1, then A1 is the anchor cell and all is displaced from A1. Put a few items in A1 to A5, run code will be a better explanation.

Howard

[joeu2004]

"Howard" <lhki...@comcast.net> wrote:
> So now the OP says the list will not always be in the same
> range but wants the code to do as it does here as I have
> posted. The lists to processed will be in different columns
> and not always starting at row 1.
>
> I tried using 'For Each c In Selection' but I cannot figure
> out how to identify the header in the Selection to copy across
> as needed.

Minimally, try:

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.

Selection(1) is defensive programming: it ensures that sel references a
single cell (the header cell), even if the user selects multiple cells, even
a rectangular range.

However, that is inefficient because of the use of the clipboard. The
following runs 5.5 times faster on my computer (YMMV), if you can tolerate
the assumptions detailed below.

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

Further simplications and optimizations can be made, depending on additional
assumptions.

Assumptions:

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

This assumption is due to the use of Offset(2) instead of Offset(1) and i=1
instead of i=0.

If you do not want to make that assumption, some simple tweaks will make it
work. Let us know if you need help with that.

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

Further simplifications could be made if we one or both are not formulas.
But the changes would not improve the run time substantially.

However, if the cells contain formulas, their formats are not copied above.
That is one benefit of using the clipboard.


----- original message -----

"Howard" <lhki...@comcast.net> wrote in message
news:b0643aa5-2a41-4673...@googlegroups.com...

[Howard]

Thanks, Joeu,

Nice work! I believe all
assumptions are quite workable.

Thanks again and I will forward with a note of credit.

Regards,
Howard