Hmm,

You didn't ask for variable columns
Sorry I couldn't make it shorter!! thanks for the feedback.

This should now work for any amount of columns

Sub AlignColumns1()
Dim LastRow As Long
lastcol = ActiveSheet.UsedRange.Columns
_(ActiveSheet.UsedRange.Columns.Count).Column
myrow = 1
For c = 1 To lastcol
LastRow = Cells(65536, c).End(xlUp).Row
Range(Cells(LastRow, c), Cells(1, c)).Copy Destination:=Cells(myrow,
lastcol + 1)
myrow = myrow + LastRow
Next c
LR = Cells(65536, lastcol + 1).End(xlUp).Row
Set srange = Range(Cells(1, lastcol + 1), Cells(LR, lastcol + 1))
srange.Sort Key1:=Cells(1, lastcol + 1), Order1:=xlAscending, Header:=xlNo
srange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, lastcol +
2), _
Unique:=True
For cCount = 1 To lastcol
lRow = Cells(Rows.Count, cCount).End(xlUp).Row
For rCount = 2 To lRow
If Cells(rCount, cCount) < "" Then
CoffinNail = Cells(rCount, cCount)
Set c = Columns(lastcol + 2).Find(what:=CoffinNail)
With c.Offset(0, cCount)
.NumberFormat = "@"
.Value = CoffinNail
End With
End If
Next rCount
Next cCount

Mike

"FARAZ QURESHI" wrote:

Sure was a good but quite a lengthy piece of code. Actually it was just a
sample I presented. Can't one have a looping way to deal with multiple
columns or rows?

--
Best Regards,
FARAZ A. QURESHI


"Mike H" wrote:

Just thought of a simple fix for the = signs if they exist

Sub AlignColumns()
Columns("A").Copy Destination:=Columns("E")
lrB = Range("B" & Rows.Count).End(xlUp).Row
lrC = Range("C" & Rows.Count).End(xlUp).Row
lrD = Range("D" & Rows.Count).End(xlUp).Row
lrE = Range("E" & Rows.Count).End(xlUp).Row

Range("B2:B" & lrB).Copy Destination:=Range("E" & (lrE + 1))
lrE = Range("E" & Rows.Count).End(xlUp).Row
Range("C2:C" & lrC).Copy Destination:=Range("E" & (lrE + 1))
lrE = Range("E" & Rows.Count).End(xlUp).Row
Range("D2:D" & lrC).Copy Destination:=Range("E" & (lrE + 1))
lrE = Range("E" & Rows.Count).End(xlUp).Row
Set sRange = Range("E2:E" & lrE)
sRange.Sort _
Key1:=Range("E1"), Order1:=xlAscending, Header:=xlNo

sRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F2"), _
Unique:=True

For cCount = 1 To 4
lRow = Cells(Rows.Count, cCount).End(xlUp).Row
For rCount = 2 To lRow
If Cells(rCount, cCount) < "" Then
CoffinNail = Cells(rCount, cCount)
Set c = Columns("F").Find(what:=CoffinNail)
With c.Offset(0, cCount)
.NumberFormat = "@"
.Value = CoffinNail
End With
End If
Next rCount
Next cCount
Range("A1:D1").Copy Destination:=Range("G1")
Columns("A:F").Delete
Rows(2).Delete
End Sub

Mike

"Mike H" wrote:

Hi,

Do you really have a row of = signs? This assumes you don't and you just
have a single header row of store 1 etc. If you do have the row of = signs
and can't ammend the code to allow for this then post back. Right click your
sheet tab, view code and paste this in and run it.

I've left an empty row for the = signs if you don't want it then delete it
with the commented out row at the end

Sub AlignColumns()
Columns("A").Copy Destination:=Columns("E")
lrB = Range("B" & Rows.Count).End(xlUp).Row
lrC = Range("C" & Rows.Count).End(xlUp).Row
lrD = Range("D" & Rows.Count).End(xlUp).Row
lrE = Range("E" & Rows.Count).End(xlUp).Row

Range("B2:B" & lrB).Copy Destination:=Range("E" & (lrE + 1))
lrE = Range("E" & Rows.Count).End(xlUp).Row
Range("C2:C" & lrC).Copy Destination:=Range("E" & (lrE + 1))
lrE = Range("E" & Rows.Count).End(xlUp).Row
Range("D2:D" & lrC).Copy Destination:=Range("E" & (lrE + 1))

lrE = Range("E" & Rows.Count).End(xlUp).Row
Set sRange = Range("E2:E" & lrE)
sRange.Sort _
Key1:=Range("E1"), Order1:=xlAscending, Header:=xlNo

sRange.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("F2"), _
Unique:=True

For cCount = 1 To 4
lRow = Cells(Rows.Count, cCount).End(xlUp).Row
For rCount = 2 To lRow
If Cells(rCount, cCount) < "" Then
CoffinNail = Cells(rCount, cCount)
Set c = Columns("F").Find(what:=CoffinNail)
c.Offset(0, cCount) = CoffinNail
End If
Next rCount
Next cCount
Range("A1:D1").Copy Destination:=Range("G1")
Columns("A:F").Delete
'Rows(2).Delete
End Sub


Mike


"FARAZ QURESHI" wrote:

I have a table like:

Column A Column B Column C Column D
Store 1 Store 2 Store 3 Store 4
============================
Dunhill Marlboro Dunhill Kingston
Marlboro Camel More Marlboro
Camel More Camel Dunhill
More Kingston


Could there be a way to arrange the data to be showing similar items on the
same row? For Instance:

Column A Column B Column C Column D
Store 1 Store 2 Store 3 Store 4
============================
Camel Camel Camel
Dunhill Dunhill Dunhill
Kingston Kingston
Marlboro Marlboro Marlboro
More More More

An appropriate array formula or preferably a VBA code shall be highly obliged.

Thanx!

--
Best Regards,
FARAZ A. QURESHI