Splitting rows based on 1st column value

[mrjim9]

Hello,

I am using Excel 2007. I have a requirement to split rows, from one row to multiple rows, bases on the value of the first cell in each row.

The format of the data is not consistent in the first cell of each row.

It is a timetable, with the first cell in the row containing the person's initials, eg [FB], and the second cell containing the event, eg [EVENT34].

The problem is, some rows contain more than one name in the first cell, separated by a comma, eg [BG, GH, AD] etc.

So, eg rows 1 to 4 would look something like this, in cols 1 and 2 :

[AS] [EVENT1]
[JD] [EVENT3]
[AS, BB, DF] [EVENT45]
[SD] [EVENT23]

I need to be able to make row 3 into 3 separate rows, like this :
[AS] [EVENT45]
[BB] [EVENT45]
[DF] [EVENT45]

I really don't know where to start with this one. Any help would be much appreciated!

Thanks in advance.

 

[p45cal]

try this, which assumes the topmost row of data is in row 2:

Sub nnnjj()
lr = Cells(Rows.Count, 1).End(xlUp).row
For rw = lr To [COLOR=Red]2[/COLOR] Step -1
    zzz = Split(Cells(rw, 1).Value, ",")
    If UBound(zzz) > 0 Then
        Rows(rw + 1).Resize(UBound(zzz)).Insert
        For i = 0 To UBound(zzz)
            Cells(rw + i, 1).Value = Application.Trim(zzz(i))
            Cells(rw + i, 2).Value = Cells(rw, 2).Value
        Next i
    End If
Next rw
End Sub

 

[hiker95]

mrjim9,


Welcome to the MrExcel forum.


Sample data before the macro:

Excel Workbook
	A	B	C	D	E
1	[AS]	[EVENT1]
2	[JD]	[EVENT3]
3	[AS, BB, DF]	[EVENT45]
4	[SD]	[EVENT23]
5
6
7
Sheet1

After the macro:

Excel Workbook
	A	B	C	D	E
1	[AS]	[EVENT1]		[AS]	[EVENT1]
2	[JD]	[EVENT3]		[JD]	[EVENT3]
3	[AS, BB, DF]	[EVENT45]		[AS]	[EVENT45]
4	[SD]	[EVENT23]		[BB]	[EVENT45]
5				[DF]	[EVENT45]
6				[SD]	[EVENT23]
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).


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, 07/17/2011
' http://www.mrexcel.com/forum/showthread.php?t=564921
Dim c As Range, n As Long, NR As Long
Dim Sp, A As String, H As String
Application.ScreenUpdating = False
Columns("D:E").ClearContents
For Each c In Range("A1", Range("A" & Rows.Count).End(xlUp))
  If InStr(c, ",") = 0 Then
    NR = Range("D" & Rows.Count).End(xlUp).Offset(1).Row
    If NR = 2 And Range("D1") = "" Then NR = 1
    Range("D" & NR).Resize(, 2).Value = c.Resize(, 2).Value
  Else
    NR = Range("D" & Rows.Count).End(xlUp).Offset(1).Row
    If NR = 2 And Range("D1") = "" Then NR = 1
    A = Replace(c, "[", "")
    A = Replace(A, "]", "")
    A = Replace(A, ",", "")
    Sp = Split(A, " ")
    For n = LBound(Sp) To UBound(Sp)
      H = Sp(n)
      H = "[" & Sp(n) & "]"
      Sp(n) = H
    Next n
    Range("D" & NR).Resize(UBound(Sp) + 1).Value = Application.Transpose(Sp)
    Range("E" & NR).Resize(UBound(Sp) + 1).Value = c.Offset(, 1).Value
  End If
Next c
Columns("D:E").AutoFit
Application.ScreenUpdating = True
End Sub

Then run the ReorgData macro.

 

[mrjim9]

Hello p45cal and hiker95,

A big thanks to both of you. Both of your solutions worked a treat!

Jim