Content Rotation from column to column

[rize1159]

I have a work sheet containing first name in A1 and last name in AA1. Now I want to arrange the these words in a specific order by of column differences. Let suppose A1=X,B1=Y,C1=Z, D1=W, E1=Q
we will prepare second row by keeping first letter constant at its place and replacing the others by constant column difference Like:

A1=X,B1=Z,C1=Q, D1=Y, E1=W

first letter is kept constant and second comes from third column of last row. this process will continue till all 28 names are formed in the same way. the column difference will be 1 to 28.

 

[rize1159]

WOW!!!!
yes I am waiting for update from your side.

 

[cgcamal]

Hi rize,

I think this time, the effort has provided good results, below you can see the modified macro.
According to my tests, it works with both, even and odd number of columns, but especially it
works with 28 columns which is what you really need.

Excel Workbook
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	a	b	c	d	e	f	g	h	i	j	k	l	0
2	a	c	e	g	i	k	b	d	f	h	j	l	0
3	a	d	g	j	b	e	h	k	c	f	i	l	0
4	a	e	i	b	f	j	c	g	k	d	h	l	0
5	a	f	k	d	i	b	g	l	e	j	c	h	0
6	a	g	b	h	c	i	d	j	e	k	f	l	0
7	a	h	c	j	e	l	g	b	i	d	k	f	0
8	a	i	e	b	j	f	c	k	g	d	l	h	0
9	a	j	g	d	b	k	h	e	c	l	i	f	0
10	a	k	i	g	e	c	b	l	j	h	f	d	0
11	a	l	k	j	i	h	g	f	e	d	c	b	0
12	a	b	c	d	e	f	g	h	i	j	k	l	0
The following example (12 columns

#VALUE!

1) In A1 type

Excel Workbook
Cell	Formula
B1	=CHAR(CODE(LEFT(A1,1))+1)
"a", in B1 type the formula below and copy to the right up to L1;

#VALUE!

2-) Run the macro and wait the result;
3-) In M1 copy the formula below and copy down;
4-) If all are zeros, all is ok .

Cell Formulas
Range	Formula
M1	=SUM(IF(FREQUENCY(MATCH(A1:L1,A1:L1,0),MATCH(A1:L1,A1:L1,0))>0,0))

The macro is:

[COLOR=Navy]Sub [/COLOR]Rotate_Columns()
[COLOR=Green]'César C, 04/May/2011
'Macro to rotate even and odd number of colums in specific order

[COLOR=Black][COLOR=Navy]Dim [COLOR=Black]FirstRowCols() As Variant[/COLOR]
Dim [COLOR=Black]Lc As Integer, Indx As Integer, Rep As Integer[/COLOR]
Dim [COLOR=Black]m As Integer, i As Integer, j As Integer, p As Integer[/COLOR][/COLOR][/COLOR][/COLOR]

Application.ScreenUpdating = [COLOR=Navy]False[/COLOR]

Lc = Range("A1").End(xlToRight).Column [COLOR=Green]'Last column number[/COLOR]
[COLOR=Navy]ReDim [/COLOR]FirstRowCols(1 To Lc ^ 2)

For m = 0 To Lc - 1 [COLOR=Green]'Loading array with repeated values[/COLOR]
    For n = 1 To Lc
        FirstRowCols(n + m * Lc) = Cells(1, n)
    Next
Next

For i = 2 To Lc [COLOR=Green]'Iterate from column 2 up to the last one[/COLOR]
    If i< Lc Then
      Indx = 1 + i
      Cells(i, 1) = Cells(1, 1)
        For j = 2 To Lc
            Rep = Application.WorksheetFunction.CountIf(Range(Cells(i, 1), _
            Cells(i, Lc)), FirstRowCols(Indx))
            If Rep = 0 Then
               Cells(i, j) = FirstRowCols(Indx)
            Else
               Indx = Indx + 1
               Cells(i, j) = FirstRowCols(Indx)
            End If
        Indx = Indx + i
        Next j
    Else
            For p = 1 To Lc
                Cells(i, p) = FirstRowCols(p)
            Next p
    End If
Next i
Application.ScreenUpdating = [COLOR=Navy]True[/COLOR]
[COLOR=Navy]End Sub[/COLOR]

Below is the result for 28 columns.

Hope this helps,

Regards

 

[rize1159]

Macro has done its job, I checked there were no repeats. However formula for cross verification didn't worked on real data as data was for names not for letters. Butt don't worry. Its good for me.

Thank you buddy
God bless you.

 

[rize1159]

Everything worked good

 

[cgcamal]

You're welcome.

Nice to know that now it works for you.

Best regards