Multiple transpose function from rows into columns

[fletchy888]

Hi there,

I am looking for a method to be able to do multiple transpose function, rather than doing it seperately.

I have approximately 5000 rows of data 2 columns, that needs to be converted into 6 columns of data so hence 1000 rows. So I want to know of method of doing it all in one go rather than 1000 seperate times, as it is very time consuming.

after being converted, some rows may have only 4 or upto 6 columns of data.

Here is it looks like now:

1 - LA1
1 - LA2
1 - LA3
1 - LA4
1 - LA5
2 - LB1
2 - LB2
2 - LB3
2 - LB4
2 - LB5
3 - LC1
3 - LC2
3 - LC4
3 - LC3


I want to change it into this format:

1 LA1 LA2 LA3 LA4 LA5
2 LB1 LB2 LB3 LB4 LB5
3 LC1 LC2 LC3 LC4 LC5


I thank anyone in advanced that can help with this problem alot!

Regards

Fletchy888

[stanleydgromjr]

fletchy888,

Welcome to the Excel Forum.

It is hard to tell where your data begins (rows and columns).

To get the most precise answer, it is best to upload/attach a sample workbook (sensitive data scrubbed/removed/changed) that contains an example of your raw data on one worksheet, and on another worksheet your desired results.

The structure and data types of the sample workbook must exactly duplicate the real workbook. Include a clear and explicit explanation of your requirements.

To attach your workbook, click on the New Post button, then scroll down and click on the Go Advanced button, then scroll down and click on the Manage Attachments button.

[NBVC]

Here is a method using Formulas only.

Assuming your data is in Sheet1, column A:B, starting at A2.

First in a new column, say C2, enter:

=A2&"_"&COUNTIF(A$2:A2,A2)

copied down.

Then in Sheet2, A2

=COUNTIF(Sheet1!A:A,B2)

copied down

In column B list your unique numbers and then in C2:

=IF(COLUMNS(Sheet1!$F$1:F$1)>$A2,"",INDEX(Sheet1!$B:$B,MATCH($B2&"_"&COLUMNS(Sheet1!$F$1:F$1),Sheet1!$C:$C,0)))

copied down and across.

Then copy everything in Sheet2, and Edit|Paste Special >> Values over itself.

You can then delete column A in Sheet2 and have your data.

[fletchy888]

I noticed that I said that I am using excel 2010, it is the 2003 version that I am using, my apologies.

[fletchy888]

A sample of my file is in the attachment

[NBVC]

Try the solution I offered above.

[stanleydgromjr]

fletchy888,

Thanks for the workbook.

I assume that your raw data is always in worksheet Sheet1. The macro will create a new worksheet Results.


Detach/open workboo ReorgData arrays w1 Aary Bary wR Oary - fletchy888 - EF793907 - SDG16.xls and run macro ReorgData.



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
Option Base 1
Sub ReorgData()
' stanleydgromjr, 09/26/2011
' http://www.excelforum.com/excel-general/793907-multiple-transpose-function-from-rows-into-columns.html
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 = 0
For r = 1 To UBound(O)
  n = Application.CountIf(w1.Columns(1), O(r, 1))
  If n > Amax Then Amax = n
Next r
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)
  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.

[stanleydgromjr]

fletchy888,

I assume that your raw data is always in worksheet Sheet1. The macro will create a new worksheet Results.

Detach/open workbook ReorgData arrays w1 Aary Bary wR Oary ReDimPreserve - fletchy888 - EF793907 - SDG16.xls and run macro ReorgDataV2.


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
Option Base 1
Sub ReorgDataV2()
' stanleydgromjr, 09/27/2011
' http://www.excelforum.com/excel-general/793907-multiple-transpose-function-from-rows-into-columns.html
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 ReorgDataV2 macro.

[NBVC]

Is there any difference?

[stanleydgromjr]

NBVC,

Is there any difference?

Yes, I am now using ReDim Preserve to adjust how many columns are used in the output array, instead of the Countif formula in worksheet Sheet1.

[NBVC]

You should mention that so the OP is not confused and uses the "correct" one.