VBA To Split cell values and put it into the row below

[svkroy]

Hi,

I am in a fix. I have this data.

Column 1 Column 2
xyz 1234.76 (18.98)
xyz 6321.76/(9765.34)
xyz 85.76 765
xyz 785
xyz (234)

The logic being if values in Col 1 has "xyz" then insert a blank row below and split the corresponding second values of Col 2 in the row just beneath that, also fill "xyz" in blank Col 1 cells. If it has only one value keep the next row blank. The output is as below:

Column 1 Column 2
xyz 1234.76
xyz (18.98)
xyz 6321.76
xyz (9765.34)
xyz 85.76
xyz 765.00
xyz 785.00
xyz
xyz (234)
xyz

Any help, ideas. Thanks in advance.

 

[taurean]

I see that "1234.76 (18.98)" is split by space while 6321.76/(9765.34) by "/". What are other splitting options used in the data?

 

[hiker95]

svkroy,

Sample raw data:

Excel 2007
	A	B
1	xyz	1234.76 (18.98)
2	xyz	6321.76/(9765.34)
3	xyz	85.76 765
4	xyz	785.00
5	xyz	(234.00)
6
7
8
9
10
11
Sheet1

After the macro:

Excel 2007
	A	B
1	xyz	1234.76
2	xyz	(18.98)
3	xyz	6321.76
4	xyz	(9765.34)
5	xyz	85.76
6	xyz	765.00
7	xyz	785.00
8	xyz
9	xyz	(234.00)
10	xyz
11
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
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.

Option Explicit
Sub SplitData()
' hiker95, 11/03/2013
' http://www.mrexcel.com/forum/excel-questions/736878-visual-basic-applications-split-cell-values-put-into-row-below.html
Dim r As Long, lr As Long, s
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 1 Step -1
  If Cells(r, 1) = "xyz" Then
    If InStr(Trim(Cells(r, 2)), " ") > 0 Then
      Rows(r + 1).Insert
      Cells(r + 1, 1).Value = Cells(r, 1).Value
      s = Split(Trim(Cells(r, 2)), " ")
      Cells(r, 2).Resize(2).Value = Application.Transpose(s)
    ElseIf InStr(Trim(Cells(r, 2)), "/") > 0 Then
      Rows(r + 1).Insert
      Cells(r + 1, 1).Value = Cells(r, 1).Value
      s = Split(Trim(Cells(r, 2)), "/")
      Cells(r, 2).Resize(2).Value = Application.Transpose(s)
    Else
      Rows(r + 1).Insert
      Cells(r + 1, 1).Value = Cells(r, 1).Value
    End If
  End If
Next r
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 SplitData macro.

 

[svkroy]

I see that "1234.76 (18.98)" is split by space while 6321.76/(9765.34) by "/". What are other splitting options used in the data?

Thats it, no more splitting options. Thanks.

 

[svkroy]

svkroy,

Hi hiker 95..........I see your reply as blank..........is it my browser glitch ?

 

[hiker95]

svkroy,

Check reply #3 again.

 

[svkroy]

svkroy,

Check reply #3 again.

Hi hiker95............That works like a charm. Thanks for the code. Anyhow one question, in Row No 3 (shown below), can we make it work, if it has more than one space in between, Im sorry data is erratic and only this is pending, all else looks good to go.

xyz

85.76 765

<tbody>
</tbody>

xyz 85.76 ........ 765

 

[hiker95]

svkroy,

The YELLOW cells contain 2 spaces, and, the GREEN cell contain 3 spaces.

Sample raw data:

Excel 2007
	A	B
1	xyz	1234.76 (18.98)
2	xyz	6321.76/(9765.34)
3	xyz	85.76 765
4	xyz	785.00
5	xyz	(234.00)
6	xyz	85.76 765
7	xyz	85.76 765
8	xyz	85.76 765
9
10
11
12
13
14
15
16
17
Sheet1

After the updated macro:

Excel 2007
	A	B
1	xyz	1234.76
2	xyz	(18.98)
3	xyz	6321.76
4	xyz	(9765.34)
5	xyz	85.76
6	xyz	765.00
7	xyz	785.00
8	xyz
9	xyz	(234.00)
10	xyz
11	xyz	85.76
12	xyz	765.00
13	xyz	85.76
14	xyz	765.00
15	xyz	85.76
16	xyz	765.00
17
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).

Option Explicit
Sub SplitDataV2()
' hiker95, 11/03/2013
' http://www.mrexcel.com/forum/excel-questions/736878-visual-basic-applications-split-cell-values-put-into-row-below.html
Dim r As Long, lr As Long, s, n As Long, i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For r = lr To 1 Step -1
  If Cells(r, 1) = "xyz" Then
    If InStr(Trim(Cells(r, 2)), " ") = 1 Then
      Rows(r + 1).Insert
      Cells(r + 1, 1).Value = Cells(r, 1).Value
      s = Split(Trim(Cells(r, 2)), " ")
      Cells(r, 2).Resize(2).Value = Application.Transpose(s)
    ElseIf InStr(Trim(Cells(r, 2)), " ") > 1 Then
      Rows(r + 1).Insert
      Cells(r + 1, 1).Value = Cells(r, 1).Value
      s = Split(Trim(Cells(r, 2)), " ")
      n = r
      For i = LBound(s) To UBound(s)
        If s(i) = " " Then
          'do nothing
        ElseIf s(i) <> "" Then
          Cells(n, 2) = s(i)
          n = n + 1
        End If
      Next i
    ElseIf InStr(Trim(Cells(r, 2)), "/") > 0 Then
      Rows(r + 1).Insert
      Cells(r + 1, 1).Value = Cells(r, 1).Value
      s = Split(Trim(Cells(r, 2)), "/")
      Cells(r, 2).Resize(2).Value = Application.Transpose(s)
    Else
      Rows(r + 1).Insert
      Cells(r + 1, 1).Value = Cells(r, 1).Value
    End If
  End If
Next r
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 SplitDataV2 macro.

 

[Rick Rothstein]

I believe this slightly more compact code will work for you also (and be faster executing as well)...

Sub ExpandColumnB()
  Dim R As Long, C As Long, Parts() As String, ArrIn As Variant, ArrOut As Variant
  ArrIn = Range("A1:B" & Cells(Rows.Count, "A").End(xlUp).Row)
  ReDim ArrOut(1 To 2 * UBound(ArrIn), 1 To 2)
  For R = 1 To UBound(ArrIn)
    Parts = Split(WorksheetFunction.Trim(Replace(ArrIn(R, 2), "/", " ")) & " ")
    For C = 0 To 1
      ArrOut(2 * R - 1 + C, 1) = ArrIn(R, 1)
      ArrOut(2 * R - 1 + C, 2) = Parts(C)
    Next
  Next
  Range("A1").Resize(UBound(ArrOut), 2) = ArrOut
  Columns("B").NumberFormat = "0.00_);(0.00)"
End Sub

 

[svkroy]

Cheers guys, its you people who have kept this lively forum alive.

Rick and hiker95, kudos for helping me, I put both of them in different modules updating same data in different sheets.

hiker95, your code was easier and quick to follow. Rick, the arrows of your arrays took me for a ride. All fine guys, issue resolved. All thanks to you two.