cmross2010,
Detach/open workbook ReorgData groups ABCD G thru P plus - cmross2010 - EF816419 - SDG16.xlsm and run the ReorgData macro.
If you want to use the macro on another workbook:
Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).
1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.
Option Explicit
Sub ReorgData()
' stanleydgromjr, 02/24/2012
' http://www.excelforum.com/excel-programming/816419-transpose-macro-for-single-line-consolidation.html
Dim r As Long, lr As Long, c As Long, n As Long, nr As Long
Dim ma As Long, q As Long, a As Long, d As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
Range("A2:D" & lr).Sort key1:=Range("A2"), order1:=1, key1:=Range("D2"), order1:=1
Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns(7), Unique:=True
lr = Cells(Rows.Count, 7).End(xlUp).Row
With Cells(2, 6).Resize(lr - 1)
.FormulaR1C1 = "=COUNTIF(C[-5],RC[1])"
.Value = .Value
End With
ma = Application.Max(Columns(6))
Columns(6).ClearContents
q = 8
a = q + ma
d = a + ma
n = 0
For c = q To q + ma - 1
n = n + 1
Cells(1, c) = "Order_qty" & n
Next c
n = 0
For c = a To a + ma - 1
n = n + 1
Cells(1, c) = "Order_amt" & n
Next c
n = 0
For c = d To d + ma - 1
n = n + 1
Cells(1, c) = "Date_" & n
Next c
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = 2 To lr
nr = Range("H" & Rows.Count).End(xlUp).Offset(1).Row
n = Application.CountIf(Columns(1), Cells(r, 1))
Cells(nr, q).Resize(, n).Value = Application.Transpose(Cells(r, 2).Resize(n).Value)
Cells(nr, a).Resize(, n).Value = Application.Transpose(Cells(r, 3).Resize(n).Value)
Cells(nr, d).Resize(, n).Value = Application.Transpose(Cells(r, 4).Resize(n).Value)
r = r + n - 1
Next r
ActiveSheet.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm
Then run the ReorgData macro.
LinkBack URL
About LinkBacks
Register To Reply
Bookmarks