Creating new columns out of data in one column

[Sethomas5]

Here we go...
First off, I am using Windows 7 Enterprise, Excel 2013 on a PC.

Here is what my data looks like:

	A	B	C	D
1	EKU Class	Class Name	KCTCS Class(es)	Core Category
2	BIO 100	Biology 1	BIO 150 + BIO 151/BIO 101	Natural Sciences
3	ENG 100	English 1	ENG 095	Written Communication
4	COM 101	Communications 1	CMS 200	Oral Communications
5	CIS 100	Computer 1	CIT 105	Computer Class

Here is what I would like it to look like:

	A	B	C	D	E	F
1	EKU Class	Class Name	Natural Sciences	Written Communication	Oral Communictions	Computer Class
2	BIO 100	Biology 1	BIO 150 + BIO 151/BIO 101
3	ENG 100	English 1		ENG 095
4	COM 101	Communications 1			CMS 200
5	CIS 100	Computer 1				CIT 105

This would be sufficient, but what I would REALLY like to do is, like with the row with the BIO courses, I have two courses there separated by a "/". I would also like for anything after a "/" to become a new row, like so:

	A	B	C	D	E	F
1	EKU Class	Class Name	Natural Sciences	Written Communication	Oral Communictions	Computer Class
2	BIO 100	Biology 1	BIO 150 + BIO 151
3			BIO 101
4	ENG 100	English 1		ENG 095
5	COM 101	Communications 1			CMS 200
6	CIS 100	Computer 1				CIT 105

I hope this enough information to start getting some help.
Thanks in advance!

 

[mumps]

Try:

Sub Test()
    Application.ScreenUpdating = False
    'Application.EnableEvents = False
    Dim LastRow As Long
    LastRow = Sheets("Sheet1").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim LastRow2 As Long
    
    Dim rng As Range
    Dim lCol As Long
    Dim sClass As Variant
    Dim i As Long
    Dim x As Long
    Dim fCell As Long
    Dim foundValRow As Long
    Range("A1:B" & LastRow).Copy Sheets("Sheet2").Cells(1, 1)
    For Each rng In Range("D2:D" & LastRow)
        lCol = Sheets("Sheet2").UsedRange.Columns.Count
        Sheets("Sheet2").Cells(1, lCol + 1) = rng
        fCell = Sheets("Sheet2").Columns(lCol + 1).Find(what:="*", after:=Cells(1, lCol + 1), LookIn:=xlValues).Row + 1
        If Len(rng.Offset(0, -1)) - Len(Replace(rng.Offset(0, -1).Value, "/", "")) > 0 Then
            sClass = Split(rng.Offset(0, -1), "/")
            For i = LBound(sClass) To UBound(sClass)
                Sheets("Sheet2").Rows(fCell + 1).Insert
                Sheets("Sheet2").Cells(fCell, lCol + 1) = sClass(i)
                fCell = fCell + 1
            Next i
        Else
            foundValRow = Sheets("Sheet2").Range("B:B").Find(rng.Offset(0, -2), LookIn:=xlValues, lookat:=xlWhole).Row
            Sheets("Sheet2").Cells(foundValRow, lCol + 1) = rng.Offset(0, -1)
        End If
    Next rng
    LastRow2 = Sheets("Sheet2").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For x = LastRow2 To 2 Step -1
        If WorksheetFunction.CountA(Sheets("Sheet2").Rows(x)) = 0 Then
            Sheets("Sheet2").Rows(x).EntireRow.Delete
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

 

[Sethomas5]

@mumps

Thanks for your reply!

Does this code create a new sheet?
I'm not sure why you're using Sheet1 and Sheet2

 

[mumps]

Since you didn't specify any sheet names, I used the default name of Sheet1 as the name of your sheet that contains the data you posted and the changes you requested are placed in Sheet2. If your sheet names don't match, either the names in the code or your sheet names will have to be changed so that they match.

 

[Sethomas5]

@mumps

Is there anyway to do this where the data with the changes are kept in the same sheet? Either replacing the old, or moved over a few columns?

 

[hiker95]

Sethomas5,

Thanks for the Private Message.

Here is another macro solution for you to consider, that will adjust to the varying number of raw data rows, and, columns.

You can change the raw data worksheet name in the macro.

Sample raw data:

Excel 2007
	A	B	C	D
1	EKU Class	Class Name	KCTCS Class(es)	Core Category
2	BIO 100	Biology 1	BIO 150 + BIO 151/BIO 101	Natural Sciences
3	ENG 100	English 1	ENG 095	Written Communication
4	COM 101	Communications 1	CMS 200	Oral Communications
5	CIS 100	Computer 1	CIT 105	Computer Class
6
Sheet1

After the macro in a new worksheet Output:

Excel 2007
	A	B	C	D	E	F	G
1	EKU Class	Class Name	Natural Sciences	Written Communication	Oral Communications	Computer Class
2	BIO 100	Biology 1	BIO 150 + BIO 151
3			BIO 101
4	ENG 100	English 1		ENG 095
5	COM 101	Communications 1			CMS 200
6	CIS 100	Computer 1				CIT 105
7
Output

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.

Sub ReorgData()
' hiker95, 10/07/2015, ME892498
Dim w1 As Worksheet, wo As Worksheet
Dim d As Range, cc As Range, lr As Long, nr As Long
Dim s, i As Long
Application.ScreenUpdating = False
Set w1 = Sheets("Sheet1")   '<-- you can change the sheet name here
If Not Evaluate("ISREF(Output!A1)") Then Worksheets.Add(After:=w1).Name = "Output"
Set wo = Sheets("Output")
wo.UsedRange.Clear
With w1
  .Activate
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  wo.Range("A1").Resize(, 2).Value = w1.Range("A1").Resize(, 2).Value
  wo.Range("C1").Resize(, lr - 1).Value = Application.Transpose(.Range("D2:D" & lr))
  wo.Range("A1").Resize(, 2 + lr - 1).Font.Bold = True
  nr = 1
  For Each d In .Range("C2", .Range("C" & Rows.Count).End(xlUp))
    Set cc = wo.Rows(1).Find(d.Offset(, 1).Value, LookAt:=xlWhole)
    If InStr(d, "/") Then
      s = Split(d, "/")
      For i = LBound(s) To UBound(s)
        If i = 0 Then
          nr = nr + 1
          wo.Cells(nr, 1).Resize(, 2).Value = .Cells(d.Row, 1).Resize(, 2).Value
          wo.Cells(nr, cc.Column).Value = s(0)
        Else
          nr = nr + 1
          wo.Cells(nr, cc.Column).Value = s(i)
        End If
      Next i
    Else
      nr = nr + 1
      wo.Cells(nr, 1).Resize(, 2).Value = .Cells(d.Row, 1).Resize(, 2).Value
      wo.Cells(nr, cc.Column).Value = d.Value
    End If
  Next d
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 ReorgData macro.

 

[hiker95]

@mumps

Is there anyway to do this where the data with the changes are kept in the same sheet? Either replacing the old, or moved over a few columns?

Sethomas5,

Be back in a little while with results (moved over a few columns).

 

[hiker95]

Sethomas5,

Here is another macro solution for you to consider, based on your latest request.

You can change the raw data worksheet name in the macro.

Sample raw data:

Excel 2007
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	EKU Class	Class Name	KCTCS Class(es)	Core Category
2	BIO 100	Biology 1	BIO 150 + BIO 151/BIO 101	Natural Sciences
3	ENG 100	English 1	ENG 095	Written Communication
4	COM 101	Communications 1	CMS 200	Oral Communications
5	CIS 100	Computer 1	CIT 105	Computer Class
6
Sheet1

And, after the new macro:

Excel 2007
	G	H	I	J	K	L	M
1	EKU Class	Class Name	Natural Sciences	Written Communication	Oral Communications	Computer Class
2	BIO 100	Biology 1	BIO 150 + BIO 151
3			BIO 101
4	ENG 100	English 1		ENG 095
5	COM 101	Communications 1			CMS 200
6	CIS 100	Computer 1				CIT 105
7
Sheet1

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

Sub ReorgData_V2()
' hiker95, 10/07/2015, ME892498
Dim d As Range, cc As Range, lr As Long, nr As Long
Dim s, i As Long
Application.ScreenUpdating = False
With Sheets("Sheet1")   '<-- you can change the sheet name here
  lr = .Cells(Rows.Count, 1).End(xlUp).Row
  .Range("G1").Resize(, 2).Value = .Range("A1").Resize(, 2).Value
  .Range("I1").Resize(, lr - 1).Value = Application.Transpose(.Range("D2:D" & lr))
  .Range("G1").Resize(, 2 + lr - 1).Font.Bold = True
  nr = 1
  For Each d In .Range("C2", .Range("C" & Rows.Count).End(xlUp))
    Set cc = .Rows(1).Find(d.Offset(, 1).Value, LookAt:=xlWhole)
    If InStr(d, "/") Then
      s = Split(d, "/")
      For i = LBound(s) To UBound(s)
        If i = 0 Then
          nr = nr + 1
          .Cells(nr, "G").Resize(, 2).Value = .Cells(d.Row, 1).Resize(, 2).Value
          .Cells(nr, cc.Column).Value = s(0)
        Else
          nr = nr + 1
          .Cells(nr, cc.Column).Value = s(i)
        End If
      Next i
    Else
      nr = nr + 1
      .Cells(nr, "G").Resize(, 2).Value = .Cells(d.Row, 1).Resize(, 2).Value
      .Cells(nr, cc.Column).Value = d.Value
    End If
  Next d
  .UsedRange.Columns.AutoFit
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_V2 macro.

 

[Sethomas5]

@hiker95

Thank you so much for your responses!!! I think we've almost got it.

When I ran the macro (second one you posted), this is what the output looked like:

	G	H	I	J	K	L	M	N	O
1	EKU CLASS	CLASSNAME	Natural Sciences	Natural Sciences	Natural Sciences	Written Communication	Oral Communications		Computer Class
2	BIO 100	Biology I	BIO 150 + 151
3			BIO 101
4	BIO 101	Biology 2	BIO 152 + 153
5	ENG 101	English 1				ENG 095
6	COM 101	Communications I					CMS 200
7	BIO 100	Biology 3
8	CIS 100	Computer 1							CIT 105

I suppose I made my sample data too simple. Here are a few more criteria I failed to mention:

Multiple classes can have equivalencies under the same core category (Natural Sciences, etc.) (I think that's why it made 3 Natural Sciences columns)
A course could have no equivalencies, resulting in a blank under KCTCS Classe(es) in the original data. (I think that's why the N column in the output data is blank)

 

[hiker95]

Sethomas5,

In order to continue, and, so that I can get it right on the next try, I would like to see screenshots of what your actual data, and, results should look like.

Or, I would like to see your actual workbook/worksheets:

The following is a free site:

https://dropbox.com