Converting multiple columns into rows with the same A column

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
cln014,

Welcome to the MrExcel forum.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

3. Can we have another workbook with the raw data in its actual sheet name, and, in another worksheet (manually formatted by you) with the results you are looking for?
 
Upvote 0
cln014,

Welcome to the MrExcel forum.

1. What version of Excel, and, Windows are you using?

2. Are you using a PC or a Mac?

3. Can we have another workbook with the raw data in its actual sheet name, and, in another worksheet (manually formatted by you) with the results you are looking for?
Thanks for the welcome. 2010 on a PC. Here is what you requested: https://app.box.com/s/zlkzrabraulphrt7ivkpjxcdmtciaoxf
 
Last edited:
Upvote 0
Upvote 0
cln014,

Thanks for the new workbook.

Here is a macro solution for you to consider, that uses two arrays in memory, that will adjust to the varying number of raw data rows, and, columns.

Sample raw data, and, results, in the active worksheet (in two screenshots to fit in the MrExcel display area):


Excel 2007
ABCDEFGHIJ
1CWIDScholarship Code 1Scholarship Award 1Scholarship Award Amount 1Scholarship Code 2Scholarship Award 2Scholarship Award Amount 2Scholarship Code 3Scholarship Award 3Scholarship Award Amount 3
2136116OS250017716BO2196325810CC500
3218116PR1470017716BO2196325810CC500
4318116PR1470017716BO2196325810CC500
5418116PR1470017716BO21963
657116SB4500
767116SB4500
8
9
10
11
12
13
14
15
externalawards002008_test



Excel 2007
MNOP
1CWIDScholarship CodeScholarship AwardScholarship Award Amount
2136116OS2500
3117716BO21963
4125810CC500
5218116PR14700
6217716BO21963
7225810CC500
8318116PR14700
9317716BO21963
10325810CC500
11418116PR14700
12417716BO21963
1357116SB4500
1467116SB4500
15
externalawards002008_test


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
2. Open your NEW 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
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Sub ReorgData()
' hiker95, 04/30/2015, ME852326
Dim a As Variant, o As Variant
Dim lr As Long, lc As Long, luc As Long
Dim i As Long, j As Long, c As Long, n As Long
With ActiveSheet
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, 1).End(xlToRight).Column
  luc = .Cells(1, Columns.Count).End(xlToLeft).Column
  If luc > lc Then
    .Columns(lc + 3).Resize(, 4).ClearContents
  End If
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  ReDim o(1 To (UBound(a, 1) * ((lc - 1) / 3)), 1 To 4)
  j = j + 1
  o(j, 1) = "CWID": o(j, 2) = "Scholarship Code"
  o(j, 3) = "Scholarship Award": o(j, 4) = "Scholarship Award Amount"
  For i = 2 To UBound(a, 1)
    For c = 2 To lc Step 3
      If a(i, c) = "" And a(i, c + 1) = "" And a(i, c + 2) = "" Then
        'do nothing
      Else
        j = j + 1
        o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
        o(j, 3) = a(i, c + 1): o(j, 4) = a(i, c + 2)
      End If
    Next c
  Next i
  .Cells(1, lc + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(lc + 3).Resize(, 4).AutoFit
End With
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.
 
Upvote 0
cln014,

Thanks for the new workbook.

Here is a macro solution for you to consider, that uses two arrays in memory, that will adjust to the varying number of raw data rows, and, columns.

Sample raw data, and, results, in the active worksheet (in two screenshots to fit in the MrExcel display area):

Excel 2007
ABCDEFGHIJ
1CWIDScholarship Code 1Scholarship Award 1Scholarship Award Amount 1Scholarship Code 2Scholarship Award 2Scholarship Award Amount 2Scholarship Code 3Scholarship Award 3Scholarship Award Amount 3
2136116OS250017716BO2196325810CC500
3218116PR1470017716BO2196325810CC500
4318116PR1470017716BO2196325810CC500
5418116PR1470017716BO21963
657116SB4500
767116SB4500
8
9
10
11
12
13
14
15

<tbody>
</tbody>
externalawards002008_test



Excel 2007
MNOP
1CWIDScholarship CodeScholarship AwardScholarship Award Amount
2136116OS2500
3117716BO21963
4125810CC500
5218116PR14700
6217716BO21963
7225810CC500
8318116PR14700
9317716BO21963
10325810CC500
11418116PR14700
12417716BO21963
1357116SB4500
1467116SB4500
15

<tbody>
</tbody>
externalawards002008_test



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
2. Open your NEW 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
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Code:
Sub ReorgData()
' hiker95, 04/30/2015, ME852326
Dim a As Variant, o As Variant
Dim lr As Long, lc As Long, luc As Long
Dim i As Long, j As Long, c As Long, n As Long
With ActiveSheet
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, 1).End(xlToRight).Column
  luc = .Cells(1, Columns.Count).End(xlToLeft).Column
  If luc > lc Then
    .Columns(lc + 3).Resize(, 4).ClearContents
  End If
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  ReDim o(1 To (UBound(a, 1) * ((lc - 1) / 3)), 1 To 4)
  j = j + 1
  o(j, 1) = "CWID": o(j, 2) = "Scholarship Code"
  o(j, 3) = "Scholarship Award": o(j, 4) = "Scholarship Award Amount"
  For i = 2 To UBound(a, 1)
    For c = 2 To lc Step 3
      If a(i, c) = "" And a(i, c + 1) = "" And a(i, c + 2) = "" Then
        'do nothing
      Else
        j = j + 1
        o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
        o(j, 3) = a(i, c + 1): o(j, 4) = a(i, c + 2)
      End If
    Next c
  Next i
  .Cells(1, lc + 3).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(lc + 3).Resize(, 4).AutoFit
End With
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgData macro.

You are the man! THANK YOU.

EDIT: One more question -- how can I get the results to output onto a new worksheet?
 
Last edited:
Upvote 0
cln014,

You are the man! THANK YOU.

Thanks for the feedback.

You are very welcome. Glad I could help.

One more question -- how can I get the results to output onto a new worksheet?

1. What is the raw data worksheet name?

2. Do you have a preference for the new worksheet name?

2a. What should be the first cell to contain CWID?
 
Upvote 0
cln014,

Here is a new macro for you to consider based on your answers to my questions.

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).

Code:
Sub ReorgDataV2()
' hiker95, 04/30/2015, ME852326
Dim w1 As Worksheet, wo As Worksheet
Dim a As Variant, o As Variant
Dim lr As Long, lc As Long
Dim i As Long, j As Long, c As Long, n As Long
Application.ScreenUpdating = False
Set w1 = Sheets("externalawards002008")   '<-- you can change the sheet name here
With w1
  .Activate
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  lc = .Cells(1, 1).End(xlToRight).Column
  a = .Range(.Cells(1, 1), .Cells(lr, lc))
  ReDim o(1 To (UBound(a, 1) * ((lc - 1) / 3)), 1 To 4)
End With
j = j + 1
o(j, 1) = "CWID": o(j, 2) = "Scholarship Code"
o(j, 3) = "Scholarship Award": o(j, 4) = "Scholarship Award Amount"
For i = 2 To UBound(a, 1)
  For c = 2 To lc Step 3
    If a(i, c) = "" And a(i, c + 1) = "" And a(i, c + 2) = "" Then
      'do nothing
    Else
      j = j + 1
      o(j, 1) = a(i, 1): o(j, 2) = a(i, c)
      o(j, 3) = a(i, c + 1): o(j, 4) = a(i, c + 2)
    End If
  Next c
Next i
If Not Evaluate("ISREF(Output!A1)") Then Worksheets.Add(After:=w1).Name = "Output"
Set wo = Sheets("Output")
With wo
  .UsedRange.Clear
  .Cells(1, 1).Resize(UBound(o, 1), UBound(o, 2)) = o
  .Columns(1).Resize(, UBound(o, 2)).AutoFit
  .Activate
End With
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, and, answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

Then run the ReorgDataV2 macro.
 
Upvote 0

Forum statistics

Threads
1,213,484
Messages
6,113,923
Members
448,533
Latest member
thietbibeboiwasaco

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
Back
Top