VBA code to split cells with pipe into multiple rows

I need a VBA code to split cells with pipe into multiple rows, only inserting the cells' contents into the rows inserted below. For example, I have a spreadsheet with 4 quantities split by a pipe in cell I2, and 4 prices split in a cell by a pipe in J2. I need the quantities and prices to insert respectively in the row beneath.

Original:
(A2)simple (I2)150|500|1000|3000 (J2)2.36|2.17|2.02|1.88
(A3)simple (I3)500|1000|2000|3000 (J3)3.36|3.10|2.88|2.68

To look like:
(A2)simple (I2)150 (J2)2.36
(A3) (I3)500 (J3)2.17
(A4) (I4)1000 (J4)2.02
(A5) (I5)3000 (J5)1.88
(A6)simple (I6)500 (J6)3.36
(A7) (I7)1000 (J7)3.10
(A8) (I8)2000 (J8)2.88
(A9) (I9)3000 (I9)2.68

I'd appreciate any/all help! Thanks!

Hi

I think you're best cycling over all cells and performing the following

Check if a pipe is present
If so, split the string into N elements using a pipe
Add Rows if required
Add data in rows beneath
Loop

So here's some code...

currentRow=0
for each cell in sheet.usedrange
If cell.row <> currentRow then 
  AddedRows=0
  CurrentRow=cell.row
End if
If instr(1,cell,"|")>0 then
  Tmp= Split(cell,"|")
  If Ubound(tmp)+1>addedrows then
    Rows(cell.row+addedrows+1 &":" & cell.row+addedrows+ubound(tmp)+2).insert
  End if
  For I =1 to ubound(tmp)
    Cell.offset(I-1,0)=tmp(I)
  Next I
End if
Next cell

I'm not at a machine with excel on at the minute, so the above might need a bit of debugging, and you should properly declare all variables. but the basic framework is there.

Good luck

Mat

It must be missing something, because I can't get my worksheet to even think it's a macro to run. I am not a "pro" (obviously). Thanks for the help, though!

Try the following

sub macro()

currentRow=0
for each cell in sheet.usedrange
If cell.row <> currentRow then
AddedRows=0
CurrentRow=cell.row
End if
If instr(1,cell,"|")>0 then
Tmp= Split(cell,"|")
If Ubound(tmp)+1>addedrows then
Rows(cell.row+addedrows+1 &":" & cell.row+addedrows+ubound(tmp)+2).insert
End if
For I =1 to ubound(tmp)
Cell.offset(I-1,0)=tmp(I)
Next I
End if
Next cell

end sub

Hi

You just need to paste it into a sub

below is the working code, give me a shout if you need an explanation of anything

Sub test()
For i = 1 To 100 'no of rows to check (allow for inserted rows)
    addedrows = 0
    For j = 1 To 10 'no of colss to check
        If InStr(1, Cells(i, j), "|") > 0 Then
            tmp = Split(Cells(i, j), "|")
            If UBound(tmp) > addedrows Then
                Rows(i + addedrows + 1 & ":" & i + UBound(tmp)).Insert
                addedrows = UBound(tmp)
            End If
            For k = 0 To UBound(tmp)
                Cells(i, j).Offset(k, 0) = tmp(k)
            Next k
        End If
    Next j
Next i
End Sub

Cheers

Mat

It's working, but ends at row 57. There are more rows in the spreadsheet.

Mat-Awesome