Move Data in Columns to Rows

jpfaff

New Member
Joined
Jul 29, 2009
Messages
4
Greetings,

I have a Database that looks like this:

Item1 Component1
Item1 Component2
Item1 Component3
Item2 Component1
Item2 Component2
Item2 Component3
Item3 Component1
Item3 Componnet2
Item3 Component3
etc. etc. etc.

I want to manipulate the data to look like this:

Item1 Component1 Component2 Component3
Item2 Component1 Component2 Component3
Item3 Component1 Component2 Component3

How could I best achieve this?
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
jpfaff,


I assume that your raw data is already sorted/grouped per your example, and resides in worksheet Sheet1.


Sample raw data in worksheet Sheet1:


Excel Workbook
AB
1Item1Component1
2Item1Component2
3Item1Component3
4Item2Component1
5Item2Component2
6Item2Component3
7Item3Component1
8Item3Component2
9Item3Component3
10
Sheet1





After the macro in a new worksheet Results (the macro will accomodate additional components):


Excel Workbook
ABCD
1Item1Component1Component2Component3
2Item2Component1Component2Component3
3Item3Component1Component2Component3
4
Results





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.


Code:
Option Explicit
Option Base 1
Sub ReorgData()
' hiker95, 10/24/2011
' http://www.mrexcel.com/forum/showthread.php?t=587551
Dim w1 As Worksheet, wR As Worksheet
Dim A(), B(), O(), k
Dim r As Long, n As Long, c As Long, Amax As Long, s As Long, e As Long
Dim d1 As Object
Set w1 = Worksheets("Sheet1")
r = w1.Cells(Rows.Count, 1).End(xlUp).Row
A = w1.Range("A1:A" & r)
B = w1.Range("B1:B" & r)
Set d1 = CreateObject("scripting.dictionary")
For r = 1 To UBound(A)
  If Not d1.exists(A(r, 1)) Then
    d1(A(r, 1)) = d1.Count
  End If
Next r
k = d1.Keys
ReDim O(1 To d1.Count + 1, 1 To 1)
For r = 1 To d1.Count
  O(r, 1) = k(r - 1)
Next r
Amax = 1
ReDim Preserve O(1 To d1.Count + 1, 1 To Amax + 1)
For r = 1 To d1.Count
  s = Application.Match(O(r, 1), A, 0)
  e = Application.Match(O(r, 1), A, 1)
  If e - s + 1 > Amax Then
    Amax = e - s + 1
    ReDim Preserve O(1 To d1.Count + 1, 1 To Amax + 1)
  End If
  n = 1
  If s = e Then
    O(r, 2) = B(s, 1)
  Else
    For c = s To e Step 1
      n = n + 1
      O(r, n) = B(c, 1)
    Next c
  End If
Next r
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
wR.Range("A1").Resize(UBound(O), Amax + 1).Value = O
wR.UsedRange.Columns.AutoFit
wR.Activate
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.
 

pboltonchina

Well-known Member
Joined
Apr 24, 2008
Messages
1,095
Try this on a copy of your data
Code:
Option Explicit

Sub Consolidate()
'JBeaucaire  (9/18/2009)
'Columnar data is Sorted/Matched by column A values, merge all other cells into row format
Dim LastRow As Long, NextCol As Long
Dim LastCol As Long, Rw As Long, Cnt As Long
Dim DelRNG As Range
Application.ScreenUpdating = False

'Sort data
    LastRow = Range("A" & Rows.count).End(xlUp).Row
    Range("A1").CurrentRegion.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
    
'Seed the delete range
    Set DelRNG = Range("A" & LastRow + 10)
    
'Group matching names
    For Rw = LastRow To 2 Step -1
        If Cells(Rw, "A").Value = Cells(Rw - 1, "A").Value Then
            Range(Cells(Rw, "B"), Cells(Rw, Columns.count).End(xlToLeft)).Copy _
                Cells(Rw - 1, Columns.count).End(xlToLeft).Offset(0, 1)
            Set DelRNG = Union(DelRNG, Range("A" & Rw))
        End If
    Next Rw

'Delete unneeded rows all at once
    DelRNG.EntireRow.Delete (xlShiftUp)
    Set DelRNG = Nothing

'Add titles
    NextCol = Cells(1, Columns.count).End(xlToLeft).Column + 1
    LastCol = Cells(1, 1).CurrentRegion.Columns.count
    Range("B1", Cells(1, NextCol - 1)).Copy Range(Cells(1, NextCol), Cells(1, LastCol))

Cells.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
 

wirra

New Member
Joined
Aug 20, 2006
Messages
23

ADVERTISEMENT

Hi,

I want to do a similar process as jpfaff but when I use the code supplied by pboltonchina I don't get the correct result. My sample data is shown below - A1 to C9. After running the macro I get the data as shown in A13 to L15. As can be seen B and C work fine but A sort of repeats itself. I don't know much about VBA coding. Can someone please explain what is going wrong?

Also if column A is not sorted eg. A-C it also doesn't work properly. Does the code imply that that column A must be sorted?

Thanks for any help.

Bob


Excel Workbook
ABCDEFGHIJKL
1A12*********
2A34*********
3A56*********
4B78*********
5B910*********
6B1112*********
7C1314*********
8C1516*********
9C1718*********
10************
11************
12************
13A12345123456
14B789101112*****
15C131415161718*****
Sheet1 (5)
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
wirra,


Sample raw data in the active worksheet, not sorted, in columns A, B, and C, before the macro:


Excel Workbook
ABCDEFGHIJKL
1A12
2B78
3C1314
4A34
5B910
6C1516
7A56
8B1112
9C1718
10
Sheet1 (5)





After the macro:


Excel Workbook
ABCDEFGHIJKL
1A12A123456
2B78B789101112
3C1314C131415161718
4A34
5B910
6C1516
7A56
8B1112
9C1718
10
Sheet1 (5)





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.


Code:
Option Explicit
Sub ReorgData()
' hiker95, 11/05/2011
' http://www.mrexcel.com/forum/showthread.php?t=587551
Dim H(), lr As Long, r As Long, s As Long, e As Long, n As Long, c As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, 1).End(xlUp).Row
H = Range("A1:C" & lr)
Range("A1:C" & lr).Sort Key1:=Range("A1"), Order1:=1, Key2:=Range("B1"), Order2:=1, Header:=xlNo
Rows(1).Insert
Range("A1") = "Title"
Columns(1).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Columns(6), Unique:=True
Rows(1).Delete
lr = Cells(Rows.Count, 6).End(xlUp).Row
For r = 1 To lr Step 1
  s = Application.Match(Cells(r, 6), Columns(1), 0)
  e = Application.Match(Cells(r, 6), Columns(1), 1)
  If s = e Then
     c = Cells(r, Columns.Count).End(xlToLeft).Column + 1
     Cells(r, c).Resize(, 2).Value = Range("B" & s & ":C" & s).Value
  Else
    For n = s To e Step 1
      c = Cells(r, Columns.Count).End(xlToLeft).Column + 1
      Cells(r, c).Resize(, 2).Value = Range("B" & n & ":C" & n).Value
    Next n
  End If
Next r
Range("A1").Resize(UBound(H), 3).Value = H
Application.ScreenUpdating = True
End Sub


Then run the ReorgData macro.
 

wirra

New Member
Joined
Aug 20, 2006
Messages
23
hiker95,

That works beautifully, thanks very much. Now if I can be a pain, what if I have 12 columns of data instead of 2 (eg. 12 months sales history) after the A, B, C etc. Can your code be easily changed so that is transposes the 12 columns to rows instead of the two in my sample?

Effectively what I have are product codes with 4 years of monthly sales history with each 12 months one under the other. Hope that makes sense.

Apologies, I should have given all the information in my original post.

Cheers,

Bob
 

hiker95

Well-known Member
Joined
Apr 8, 2009
Messages
17,649
wirra,

You have hijacked jpfaff's thread. And, your new request is completely different.

I would suggest that you start your own New Post with an appropriate title.

And, in the New Post, have screenshots of the before and after raw data.

When this is accomplished you can send me a Private Message with a link to your New Post and I will be happy to assist.
 

Watch MrExcel Video

Forum statistics

Threads
1,130,119
Messages
5,640,219
Members
417,131
Latest member
Seanr19871

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top