Edit VBA Macro to separate codes

[saraereinosa]

All of the following are separate columns. Every code is separated within parentheses and by spaces. I need all codes underneath the ID#'s in ONE column. I have bolded the ID's, so that it's easier to distinguish them.

012990007720141_yr1
(4.classtruct.lec)	(7.racecons)	(5.genrat.eql) (7.gencons)	(12.other)
(7.racecons)	(7.racecons)
(4.classtruct.group) (7.gencons.thrt) (5.role.lead.n)	(5.interact.col.n) (5.interact.exl)	(5.assigned.ran) (5.interact.exl)	(5.interact.exl)
020388008195538_yr1
(4.classcont.intr) (4.impress.fun) (7.pers.pass)	(4.impress.fun) (7.pers.pass)	(4.impress.fun)	(4.calsscont.easy)	(4.classcont.easy)
(6.teachar.frnd)	(2.profs.cpp.stem) (6.teachar.rel)	(4.classtruct.size)	(2.profs.cpp.stem) (6.teachar.rel) (9.type.profs.F.stem) (6.teachar.help)
(6.teachar.f)
020492008728902_yr1
(4.classtruc.lec)	(4.classcont.intr) (2.profs.cpp) (1.stemcom)	(4.classcont.intr) (1.stemcom) (4.classtruc.hands)	(4.classcont)
(4.impress.intm) (7.pers.whelm)	(7.pers.conf.n) (1.uns)	(1.interest) (1.uns.n)	(4.impress.intm) (7.pers.whelm)	(7.pers.mot)	(1.uns)	(1.uns) (2.profs.cpp.M.stem)
020989007244965_yr1
(1.natdeg.opt) (1.natdeg.emp)	(1.natdeg.opt) (1.natdeg.emp)
(1.natdeg.opt)	(1.natdeg.opt)	(1.natdeg.opt)
(12.other) (4.classcont)	(4.classcont)	(7.gencons) (7.gencons.fid)	(7.gencons.chal)
021191008067722_yr1
(4.classcont.hard)	(4.classcont)	(4.classcont.det)
(4.classcont.brd.n)	(4.classcont.det) (7.pers.mem) (7.pers.under)
021990007175415_yr1
(7.gencons) (5.genrat.m)	(7.gencons) (7.gencons.fid)	(2.friend.F.stem) (8.nonstem.sor)	(7.racecons) (1.other)	(7.pers.org.n)	(1.other)	(7.racecons)	(1.other)	(7.gencons)	(4.classtruct.lec)	(4.classtruct.size)	(4.classcont.easy)
(4.classcont.intr)	(4.classcont)	(7.pers.study.n)	(7pers.under)	(7.pers.org)	(1.clsexp.cpp)	(4.classcont.n)	(7.pers.stud)	(4.classtruct.pace) (7.pers.cope)

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

 

[hiker95]

saraereinosa,

Welcome to the MrExcel forum.

What version of Excel are you using?


We can not tell where your raw data is located, cells, rows, columns,
and, we can not tell where the results should be, cells, rows, columns.


Can you post the raw data, and, post the results you are looking for?

To post your data, you can download and install one of the following two programs:
Excel Jeanie
MrExcel HTML Maker

Or, when using Internet Explorer, just put borders around your data in Excel and copy those cells into your post.


If you are not able to give us screenshots:
You can upload your workbook to Box Net,

sensitive data scrubbed/removed/changed

mark the workbook for sharing
and provide us with a link to your workbook.

 

[saraereinosa]

saraereinosa,

Welcome to the MrExcel forum.

What version of Excel are you using? EXCEL 2010


We can not tell where your raw data is located, cells, rows, columns, MY DATA IS IN CELLS, ROWS, AND COLUMNS.
and, we can not tell where the results should be, cells, rows, columns. ALL DATA SHOULD BE IN COLUMN A.


I don't know how to use the two things you mentioned to get the html. Essentially my data is across multiple rows and columns. I want it to take all data in cells A2, B3, C4, D4, etc. and paste it into Row A, but underneath it's corresponding ID number.

 

[hiker95]

saraereinosa,

I can not tell by your descriptions, and posted informaiton, where your raw data resides.

And, I do not understand what the results should look like.


Click on the Reply to Thread button, and just put the word BUMP in the post. Then, click on the Post Quick Reply button, and someone else will assist you.

 

[saraereinosa]

BUMPhttps://www.box.com/s/ae47dff40d5d2a9dba84

 

[hiker95]

saraereinosa,

Thanks for the workbook.

Do all of the ID#'s, like this 012990007720141_yr1, contain the string _yr?

 

[saraereinosa]

saraereinosa,

thanks for the workbook.

Do all of the id#'s, like this 012990007720141_yr1, contain the string _yr?

yes!

 

[hiker95]

saraereinosa,


Sample raw data in the first worksheet in the workbook (the left most worksheet) (not all columns thru column L are shown for brevity):

Excel Workbook
	A	B	C	D
1	012990007720141_yr1
2	(4.classtruct.lec)	(7.racecons)	(5.genrat.eql) (7.gencons)	(12.other)
3	(7.racecons)	(7.racecons)
4	(4.classtruct.group) (7.gencons.thrt) (5.role.lead.n)	(5.interact.col.n) (5.interact.exl)	(5.assigned.ran) (5.interact.exl)	(5.interact.exl)
5	020388008195538_yr1
6	(4.classcont.intr) (4.impress.fun) (7.pers.pass)	(4.impress.fun) (7.pers.pass)	(4.impress.fun)	(4.calsscont.easy)
7	(6.teachar.frnd)	(2.profs.cpp.stem) (6.teachar.rel)	(4.classtruct.size)	(2.profs.cpp.stem) (6.teachar.rel) (9.type.profs.F.stem) (6.teachar.help)
8	(6.teachar.f)
9	020492008728902_yr1
10	(4.classtruc.lec)	(4.classcont.intr) (2.profs.cpp) (1.stemcom)	(4.classcont.intr) (1.stemcom) (4.classtruc.hands)	(4.classcont)
11	(4.impress.intm) (7.pers.whelm)	(7.pers.conf.n) (1.uns)	(1.interest) (1.uns.n)	(4.impress.intm) (7.pers.whelm)
12	020989007244965_yr1
13	(1.natdeg.opt) (1.natdeg.emp)	(1.natdeg.opt) (1.natdeg.emp)
14	(1.natdeg.opt)	(1.natdeg.opt)	(1.natdeg.opt)
15	(12.other) (4.classcont)	(4.classcont)	(7.gencons) (7.gencons.fid)	(7.gencons.chal)
16	021191008067722_yr1
17	(4.classcont.hard)	(4.classcont)	(4.classcont.det)
18	(4.classcont.brd.n)	(4.classcont.det) (7.pers.mem) (7.pers.under)
19	021990007175415_yr1
20	(7.gencons) (5.genrat.m)	(7.gencons) (7.gencons.fid)	(2.friend.F.stem) (8.nonstem.sor)	(7.racecons) (1.other)
21	(4.classcont.intr)	(4.classcont)	(7.pers.study.n)	(7pers.under)
22
RAW DATA

After the macro in a new worksheet Results with data in column A going down to row 104 (not all rows are shown for brevity):

Excel Workbook
	A
1	012990007720141_yr1
2	(4.classtruct.lec)
3	(7.racecons)
4	(5.genrat.eql)
5	(7.gencons)
6	(12.other)
7	(7.racecons)
8	(7.racecons)
9	(4.classtruct.group)
10	(7.gencons.thrt)
11	(5.role.lead.n)
12	(5.interact.col.n)
13	(5.interact.exl)
14	(5.assigned.ran)
15	(5.interact.exl)
16	(5.interact.exl)
17	020388008195538_yr1
18	(4.classcont.intr)
19	(4.impress.fun)
20	(7.pers.pass)
21	(4.impress.fun)
22	(7.pers.pass)
23	(4.impress.fun)
24	(4.calsscont.easy)
25	(4.classcont.easy)
26	(6.teachar.frnd)
27	(2.profs.cpp.stem)
28	(6.teachar.rel)
29	(4.classtruct.size)
30	(2.profs.cpp.stem)
31	(6.teachar.rel)
32	(9.type.profs.F.stem)
33	(6.teachar.help)
34	(6.teachar.f)
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.

Option Explicit
Sub ReorgData()
' hiker95, 06/21/2012
' http://www.mrexcel.com/forum/showthread.php?641961-Edit-VBA-Macro-to-separate-codes
Dim w1 As Worksheet, wR As Worksheet
Dim r As Long, lr As Long, c As Long, lc As Long, Sp, nr As Long
Dim Area As Range, sr As Long, er As Long
Application.ScreenUpdating = False
Set w1 = Worksheets(1)
If Not Evaluate("ISREF(Results!A1)") Then Worksheets.Add(After:=w1).Name = "Results"
Set wR = Worksheets("Results")
wR.UsedRange.Clear
lr = w1.Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 1 Step -1
  If InStr(w1.Cells(r, 1), "_yr") > 0 Then w1.Rows(r).Insert
Next r
lc = w1.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByColumns).Column
For Each Area In w1.Range("A1", w1.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeConstants).Areas
  With Area
    sr = .Row
    er = sr + .Rows.Count - 1
    nr = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    If nr = 2 And wR.Cells(1, 1) = "" Then nr = 1
    With wR.Cells(nr, 1)
      .NumberFormat = "@"
      .Value = w1.Cells(sr, 1).Value
    End With
    For r = sr + 1 To er Step 1
      For c = 1 To lc Step 1
        If w1.Cells(r, c) <> "" Then
          If InStr(w1.Cells(r, c), " ") = 0 Then
            nr = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            wR.Cells(nr, 1).Value = w1.Cells(r, c).Value
          ElseIf InStr(w1.Cells(r, c), " ") > 0 Then
            nr = wR.Range("A" & Rows.Count).End(xlUp).Offset(1).Row
            Sp = Split(w1.Cells(r, c), " ")
            wR.Cells(nr, 1).Resize(UBound(Sp) + 1).Value = Application.Transpose(Sp)
          End If
        End If
      Next c
    Next r
  End With
Next Area
On Error Resume Next
w1.Range("A1", w1.Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
wR.Columns(1).AutoFit
wR.Activate
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.