Need Additions to Excel 2010 Macro Changing List with Commas to New Rows

Alex20850

Board Regular
Joined
Mar 9, 2010
Messages
146
Office Version
  1. 365
Platform
  1. Windows
I have a macro created for me that takes list with values with commas (see first list) and turns it into a list with new rows for the values the comma values while adding the values from the original row (see second list).

TI have two problems with the macro:
1) It overwrites the original list. I would prefer that it create an new tab named Output or that it ask me for a name.
2) It has to be a particular column. I would like to be able to tell it which column to use.

Sub Commas_to_Rows()
Dim rng As Range
Dim rngLotNos As Range
Dim arrLotNos
Set rng = Range("A2")

While rng.Value <> ""
arrLotNos = Split(rng.Offset(, 4).Value, ",")
If UBound(arrLotNos) > 0 Then
rng.Offset(1).Resize(UBound(arrLotNos)).EntireRow.Insert
rng.Resize(, 7).Copy rng.Resize(UBound(arrLotNos) + 1)
rng.Offset(, 4).Resize(UBound(arrLotNos) + 1) = Application.Transpose(arrLotNos)
End If
Set rng = rng.Offset(UBound(arrLotNos) + 1)
Wend

End Sub


OrderPresidentField 2Field 3OccupationsState
1George WashingtonLand Surveyor,Farmer,Military Officer Virginia
2John AdamsLawyer,Farmer Massachusetts
3Thomas JeffersonLand Surveyor,Writer,Inventor,Lawyer,Architect,Farmer,Diplomat,Linguist Virginia
4James MadisonFarmer Virginia
5James MonroeFarmer,Lawyer Virginia
6John Quincy AdamsLawyer Massachusetts
7Andrew JacksonMilitary Officer,Lawyer Tennessee

<tbody>
</tbody>

and turns it into a list like this:

OrderPresidentField 2Field 3OccupationsState
1George WashingtonLand Surveyor Virginia
1George WashingtonFarmer Virginia
1George WashingtonMilitary Officer Virginia
2John AdamsLawyer Massachusetts
2John AdamsFarmer Massachusetts
3Thomas JeffersonLand Surveyor Virginia
3Thomas JeffersonWriter Virginia
3Thomas JeffersonInventor Virginia
3Thomas JeffersonLawyer Virginia
3Thomas JeffersonArchitect Virginia
3Thomas JeffersonFarmer Virginia
3Thomas JeffersonDiplomat Virginia
3Thomas JeffersonLinguist Virginia
4James MadisonFarmer Virginia
5James MonroeFarmer Virginia
5James MonroeLawyer Virginia
6John Quincy AdamsLawyer Massachusetts
7Andrew JacksonMilitary Officer Tennessee
7Andrew JacksonLawyer Tennessee

<tbody>
</tbody>
 

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.
Alex20850,

Here is a macro solution for you to consider.

Sample raw data in worksheet Sheet1 (you can change the raw data worksheet name in the macro):


Excel 2007
ABCDEF
1OrderPresidentField 2Field 3OccupationsState
21George Washington11Land Surveyor,Farmer,Military OfficerVirginia
32John Adams22Lawyer,FarmerMassachusetts
43Thomas Jefferson33Land Surveyor,Writer,Inventor,Lawyer,Architect,Farmer,Diplomat,LinguistVirginia
54James Madison44FarmerVirginia
65James Monroe55Farmer,LawyerVirginia
76John Quincy Adams66LawyerMassachusetts
87Andrew Jackson77Military Officer,LawyerTennessee
9
Sheet1


After the macro in a new worksheet Results:


Excel 2007
ABCDEF
1OrderPresidentField 2Field 3OccupationsState
21George Washington11Land SurveyorVirginia
31George Washington11FarmerVirginia
41George Washington11Military OfficerVirginia
52John Adams22LawyerMassachusetts
62John Adams22FarmerMassachusetts
73Thomas Jefferson33Land SurveyorVirginia
83Thomas Jefferson33WriterVirginia
93Thomas Jefferson33InventorVirginia
103Thomas Jefferson33LawyerVirginia
113Thomas Jefferson33ArchitectVirginia
123Thomas Jefferson33FarmerVirginia
133Thomas Jefferson33DiplomatVirginia
143Thomas Jefferson33LinguistVirginia
154James Madison44FarmerVirginia
165James Monroe55FarmerVirginia
175James Monroe55LawyerVirginia
186John Quincy Adams66LawyerMassachusetts
197Andrew Jackson77Military OfficerTennessee
207Andrew Jackson77LawyerTennessee
21
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
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, 03/29/2015, ME845417
Dim w1 As Worksheet, wr As Worksheet
Dim c As Range, s, nr As Long
'Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   ''<-- you can change the raw data worksheet name here
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wr = Sheets("Results")
wr.UsedRange.Clear
wr.Range("A1").Resize(, 6).Value = w1.Range("A1").Resize(, 6).Value
With w1
  For Each c In .Range("E2", .Range("E" & Rows.count).End(xlUp))
    nr = wr.Cells(wr.Rows.count, "A").End(xlUp).Row + 1
    If InStr(c, ",") Then
      s = Split(c, ",")
      wr.Cells(nr, 1).Resize(UBound(s) + 1, 4).Value = w1.Cells(c.Row, 1).Resize(, 4).Value
      wr.Cells(nr, 5).Resize(UBound(s) + 1).Value = Application.Transpose(s)
      wr.Cells(nr, 6).Resize(UBound(s) + 1).Value = w1.Cells(c.Row, 6).Value
    Else
      wr.Cells(nr, 1).Resize(, 6).Value = w1.Range("A" & c.Row).Resize(, 6).Value
    End If
  Next c
End With
With wr
  .UsedRange.Columns.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 ReorgData macro.
 
Upvote 0
Alex20850,

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, 03/29/2015, ME845417
Dim w1 As Worksheet, wo As Worksheet
Dim c As Range, s, nr As Long
'Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   ''<-- you can change the raw data worksheet name here
If Not Evaluate("ISREF(Output!A1)") Then Worksheets.Add(After:=w1).Name = "Output"
Set wo = Sheets("Output")
wo.UsedRange.Clear
wo.Range("A1").Resize(, 6).Value = w1.Range("A1").Resize(, 6).Value
With w1
  For Each c In .Range("E2", .Range("E" & Rows.count).End(xlUp))
    nr = wo.Cells(wo.Rows.count, "A").End(xlUp).Row + 1
    If InStr(c, ",") Then
      s = Split(c, ",")
      wo.Cells(nr, 1).Resize(UBound(s) + 1, 4).Value = w1.Cells(c.Row, 1).Resize(, 4).Value
      wo.Cells(nr, 5).Resize(UBound(s) + 1).Value = Application.Transpose(s)
      wo.Cells(nr, 6).Resize(UBound(s) + 1).Value = w1.Cells(c.Row, 6).Value
    Else
      wo.Cells(nr, 1).Resize(, 6).Value = w1.Range("A" & c.Row).Resize(, 6).Value
    End If
  Next c
End With
With wo
  .UsedRange.Columns.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
Thanks, it works well. I see where I can change the source sheet, the output sheet, and the column to use in the code.
Is there a way to have it stop and ask me which column to use for the conversion to rows?
 
Upvote 0
Alex20850,

Thanks for the feedback.

You are very welcome. Glad I could help.

Is there a way to have it stop and ask me which column to use for the conversion to rows?

1. Are you talking about in the raw data worksheet?

2. If you are talking about the raw data worksheet, will the column to use for the conversion of rows, always have the title Occupations?

3. What is the purpose of this exercise/project?
 
Upvote 0
Alex20850,

Thanks for the feedback.

You are very welcome. Glad I could help.



1. Are you talking about in the raw data worksheet?
Yes

2. If you are talking about the raw data worksheet, will the column to use for the conversion of rows, always have the title Occupations?
No

3. What is the purpose of this exercise/project?
I worked for a long time in software support, but never go into macros.
Something I saw frequently was spreadsheets with items in a cell with commas, but people needed a way to have the commas created as separated rows as this does.
While I didn't do anything with genetics, here is an example of a table with commas in a cell: https://www.familytreedna.com/public/Guanches-CanaryIslandsDNA?iframe=mtresults
If this table were in Excel, I would want to be able to choose column D to create new rows while the data in columns A, B, C, and E would carried over for each new row.
I used to work on a contract at the FDA. Here is a link where they have a items in a cell, but would like to create new rows: Recalls, Market Withdrawals, & Safety Alerts
If this were brought into Excel, I would want to tell the macro to convert the items in column B and A,C, D, and E would be carried over. For our purposes, any problems with column F should be ignored.
Once again, thanks for your work. This is a very good way for me to learn macros.
 
Upvote 0
Alex20850,

Once again, thanks for your work.

Thanks for the feedback.

You are welcome.

This is a very good way for me to learn macros.

See if something, in the below link(s), of my most up to date list will help you:

Training / Books / Sites as of 1/17/2015

http://www.mrexcel.com/forum/excel-questions/829893-macros.html#post4048295


I have looked at your two links, and, do not understand what you are trying to do.

Click on the Reply to Thread button, and just put the word BUMP in the thread. Then, click on the Post Quick Reply button, and someone else will assist you.
 
Upvote 0
Sorry if I didn't explain it well.
I just want the macro to stop and ask for the column letter that goes into this line where it currently has E:
For Each c In .Range("E2", .Range("E" & Rows.count).End(xlUp))
 
Upvote 0

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,094
Latest member
teemeren

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