| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.misc
|
|||
|
|||
ALIGN DATA CELLS?
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 |
|
#2
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
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 |
|
#3
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
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 |
|
#4
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
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 |
|
#7
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
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 |
|
#8
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
Just noticed Excel 2007, this makes it 2007 proof
Sub AlignColumns1() Dim LastRow As Long lastcol = ActiveSheet.UsedRange.Columns(ActiveSheet.UsedRang e.Columns.Count).Column myrow = 1 For c = 1 To lastcol LastRow = Cells(Rows.Count, c).End(xlUp).Row Range(Cells(LastRow, c), Cells(1, c)).Copy Destination:=Cells(myrow, lastcol + 1) myrow = myrow + LastRow Next c LR = Cells(Rows.Count, 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 Range(Cells(1, 1), Cells(1, lastcol + 2)).Copy Destination:=Cells(1, lastcol + 3) Range(Cells(1, 1), Cells(1, lastcol + 2)).EntireColumn.Delete Rows(2).Delete End Sub Mike "Mike H" wrote: 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 |
|
#9
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
Thanx a lot Mike!
But the code doesn't seem to be working and showed a couple of red lines when pasted on the VBA editor and run. Sure would appreciate if you would refine it somehow! Thanx again, pal!!!! -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: 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 |
|
#10
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
And by the way with Excel 2007 the last row won't be restricted to 65536.
Can't we use the xlup/xldown technique instead? -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: 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 |
|
#11
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
The red lines will simply be line-wrap and this should cure that. It goes in
as worksheet code Sub AlignColumns1() Dim LastRow As Long lastcol = ActiveSheet.UsedRange.Columns _ (ActiveSheet.UsedRange.Columns.Count).Column myrow = 1 For c = 1 To lastcol LastRow = Cells(Rows.Count, c).End(xlUp).Row Range(Cells(LastRow, c), Cells(1, c)).Copy _ Destination:=Cells(myrow, lastcol + 1) myrow = myrow + LastRow Next c LR = Cells(Rows.Count, 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 Range(Cells(1, 1), Cells(1, lastcol + 2)).Copy _ Destination:=Cells(1, lastcol + 3) Range(Cells(1, 1), Cells(1, lastcol + 2)) _ ..EntireColumn.Delete Rows(2).Delete End Sub Mike "FARAZ QURESHI" wrote: Thanx a lot Mike! But the code doesn't seem to be working and showed a couple of red lines when pasted on the VBA editor and run. Sure would appreciate if you would refine it somehow! Thanx again, pal!!!! -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: 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 |
|
#12
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
YAHOO!!!
XCLENT!!! THANX!!! U GUYZ R SIMPLY THE BEST!!!!!!! Any idea how to learn devising such xclent codes/macros/addins???? By the way what is a worksheet code? U mean it can't be inserted into a separate module? -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: The red lines will simply be line-wrap and this should cure that. It goes in as worksheet code Sub AlignColumns1() Dim LastRow As Long lastcol = ActiveSheet.UsedRange.Columns _ (ActiveSheet.UsedRange.Columns.Count).Column myrow = 1 For c = 1 To lastcol LastRow = Cells(Rows.Count, c).End(xlUp).Row Range(Cells(LastRow, c), Cells(1, c)).Copy _ Destination:=Cells(myrow, lastcol + 1) myrow = myrow + LastRow Next c LR = Cells(Rows.Count, 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 Range(Cells(1, 1), Cells(1, lastcol + 2)).Copy _ Destination:=Cells(1, lastcol + 3) Range(Cells(1, 1), Cells(1, lastcol + 2)) _ .EntireColumn.Delete Rows(2).Delete End Sub Mike "FARAZ QURESHI" wrote: Thanx a lot Mike! But the code doesn't seem to be working and showed a couple of red lines when pasted on the VBA editor and run. Sure would appreciate if you would refine it somehow! Thanx again, pal!!!! -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: 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 |
|
#13
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
Hi,
It can go in a general module you'll just have to ensure that the sheet you working on is the active sheet sheets("Sheet1").select or whichever sheet you want as the first line in the code Mike "FARAZ QURESHI" wrote: YAHOO!!! XCLENT!!! THANX!!! U GUYZ R SIMPLY THE BEST!!!!!!! Any idea how to learn devising such xclent codes/macros/addins???? By the way what is a worksheet code? U mean it can't be inserted into a separate module? -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: The red lines will simply be line-wrap and this should cure that. It goes in as worksheet code Sub AlignColumns1() Dim LastRow As Long lastcol = ActiveSheet.UsedRange.Columns _ (ActiveSheet.UsedRange.Columns.Count).Column myrow = 1 For c = 1 To lastcol LastRow = Cells(Rows.Count, c).End(xlUp).Row Range(Cells(LastRow, c), Cells(1, c)).Copy _ Destination:=Cells(myrow, lastcol + 1) myrow = myrow + LastRow Next c LR = Cells(Rows.Count, 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 Range(Cells(1, 1), Cells(1, lastcol + 2)).Copy _ Destination:=Cells(1, lastcol + 3) Range(Cells(1, 1), Cells(1, lastcol + 2)) _ .EntireColumn.Delete Rows(2).Delete End Sub Mike "FARAZ QURESHI" wrote: Thanx a lot Mike! But the code doesn't seem to be working and showed a couple of red lines when pasted on the VBA editor and run. Sure would appreciate if you would refine it somehow! Thanx again, pal!!!! -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: 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 |
|
#14
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
Any idea how to learn devising such xclent codes/macros/addins????
Others may disagree with your assesment of the excellence of this code but to learn you could do worse than hang around in these forums and I would recommend any of the MVP sites and John Walkenbach's books. Mike "FARAZ QURESHI" wrote: YAHOO!!! XCLENT!!! THANX!!! U GUYZ R SIMPLY THE BEST!!!!!!! Any idea how to learn devising such xclent codes/macros/addins???? By the way what is a worksheet code? U mean it can't be inserted into a separate module? -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: The red lines will simply be line-wrap and this should cure that. It goes in as worksheet code Sub AlignColumns1() Dim LastRow As Long lastcol = ActiveSheet.UsedRange.Columns _ (ActiveSheet.UsedRange.Columns.Count).Column myrow = 1 For c = 1 To lastcol LastRow = Cells(Rows.Count, c).End(xlUp).Row Range(Cells(LastRow, c), Cells(1, c)).Copy _ Destination:=Cells(myrow, lastcol + 1) myrow = myrow + LastRow Next c LR = Cells(Rows.Count, 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 Range(Cells(1, 1), Cells(1, lastcol + 2)).Copy _ Destination:=Cells(1, lastcol + 3) Range(Cells(1, 1), Cells(1, lastcol + 2)) _ .EntireColumn.Delete Rows(2).Delete End Sub Mike "FARAZ QURESHI" wrote: Thanx a lot Mike! But the code doesn't seem to be working and showed a couple of red lines when pasted on the VBA editor and run. Sure would appreciate if you would refine it somehow! Thanx again, pal!!!! -- Best Regards, FARAZ A. QURESHI "Mike H" wrote: 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 |
|
#15
Posted to microsoft.public.excel.misc
|
|||
|
|||
|
ALIGN DATA CELLS?
Assumes NO header row. Correct for word wrap where you see red text
Sub doitall() 'make list lcol = Cells.Find("*", Cells(1, Columns.Count), , , xlByColumns, xlPrevious).Column lRow = Cells.Find("*", Cells(Rows.Count, 1), , , xlByRows, xlPrevious).Row For c = 1 To lcol 'columns slr = Cells(Rows.Count, c).End(xlUp).Row dlr = Cells(Rows.Count, lcol + 1).End(xlUp).Row + 1 Cells(2, c).Resize(slr).Copy Cells(dlr, lcol + 1) Next c 'make unique list from list Cells(1, lcol + 1).Value = "x" LR = Cells(Rows.Count, lcol + 1).End(xlUp).Row Range(Cells(2, lcol + 1), Cells(LR, lcol + 1)) _ .Sort Key1:=Cells(2, lcol + 1), Order1:=xlAscending, Header:=xlGuess, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom Range(Cells(1, lcol + 1), Cells(LR, lcol + 1)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Cells(1, lcol + 2), Unique:=True 'arrange For Each c In Range(Cells(2, lcol + 2), Cells(LR, lcol + 2)) For i = 1 To 4 For j = 1 To 4 If Cells(i, j) = c Then c.Offset(, j + 1) = c Next j Next i Next c End Sub -- Don Guillett Microsoft MVP Excel SalesAid Software "FARAZ QURESHI" wrote in message ... 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 |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Align matching cells of two different columns | Excel Worksheet Functions | |||
| Left align '$' and right align numbers? | Excel Discussion (Misc queries) | |||
| how to align vertical cells horizontally | New Users to Excel | |||
| How do I align cells in Excel onto one line? | Excel Worksheet Functions | |||
| What is short-Cut forleft align and Right align? | Excel Discussion (Misc queries) | |||
Linear Mode
