Split multiple line cell into seperate cells 1

[redjoy]

Problem:
I would like to create separate rows for 1 B through G and 3 B through E without affecting the formula.

What I currently have is under the before section.
What I want to accomplish is under the after section.

before after
hdr1 hdr2 hdr3 hdr1 hdr2 hdr3
---- ---- ---- ---- ---- ----
1 A xx 1
B xx ---- ---- ----
C xx A xx
D xx ---- ---- ----
E xx B xx
F xx ---- ---- ----
G xx C xx
---- ---- ---- ---- ---- ---
2 A xx D xx
---- ---- ---- ---- ---- ---
3 B xx E xx
C xx ---- ---- ---
D xx F xx
E xx ---- ---- ---
---- ---- ---- G xx
---- ---- ----
2 A xx
---- ---- ----
3 B xx
---- ---- ----
C xx
---- ---- ----
D xx
---- ---- ----
E xx
---- ---- ----
forumla based on current rows (1,2,3,...).


I was thinking something about inserting a new row below the current row and moving the last line to the newly created row, repeat until all lines = 0.

How would I go about this since I am new to VBA scripting in general?

Thanks,
Michael

 

[SkipVought]

Michael,

Use this sub to parse your data

Sub ParseOnCRLF(rng As Range)
    With rng
        a = Split(.Value, vbLf)
        For i = LBound(a, 1) To UBound(a, 1)
            b = Split(a(i), " ")
            k = 0
            For j = LBound(b, 1) To UBound(b, 1)
                If j > LBound(b, 1) Then
                    If b(j) = b(j - 1) Then
                        k = k + 1
                    End If
                End If
                .Offset(0 + i, 1 + j - k).Value = b(j)
            Next
        Next
    End With
End Sub

where rng is the Individual Cell Range.

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[redjoy]

Skip

Thank you for your solution. I made some minor changes to achieve my desired output (Insert an entire row after the current row before I paste the data).

Sub ParseOnCRLF([COLOR=yellow red] [/color yellow red])
    [COLOR=red]Dim wrksht As Worksheet
    Dim rng As Range
   
    Set wrksht = ActiveSheet
    Set rng = ActiveCell[/color red]
     
    With rng
        a = Split(.Value, vbLf)
        For i = LBound(a, 1) To UBound(a, 1)
            b = Split(a(i), " ")
            k = 0
            For j = LBound(b, 1) To UBound(b, 1)
                If j > LBound(b, 1) Then
                    If b(j) = b(j - 1) Then
                        k = k + 1
                    End If
                End If
                [COLOR=red]ActiveCell.Offset(1 + i, j - k).EntireRow.Insert (xlShiftDown)
                .Offset(1 + i, j - k).Value = b(j)[/color red]
            Next
        Next
    End With
End Sub

I tried to do this for an entire spreadsheet but I have not yet created a form to select multiple row with the above code (parameter missing in my code). BTW I am running this from within an Excel spreadsheet.

Michael

 

[SkipVought]

What you want to do is loop thru a selection of cells.

Select the cells

for each c in selection
  ParseOnCRLF(c)
next

Skip,

Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[redjoy]

Skip,
Again Thanks for the advice. Here is the code that I am currently running:

Sub ParseOnCRLF()
    Dim wrksht As Worksheet
    Dim rng As Range
   
    Set wrksht = ActiveSheet
    Set rng = ActiveCell
  For ct = Selection.Count To 1 Step -1
      
    Set rng = Selection.Item(ct)
    With rng
        a = Split(.Value, vbLf)
        For i = LBound(a, 1) To UBound(a, 1)
            b = Split(a(i), " ")
            k = 0
            For j = LBound(b, 1) To UBound(b, 1)
                If j > LBound(b, 1) Then
                    If b(j) = b(j - 1) Then
                        k = k + 1
                    End If
                End If
                rng.Offset(1 + i, j - k).EntireRow.Insert (xlShiftDown)
                .Offset(1 + i, j - k).Value = b(j)
            Next
        Next
        rng.Clear
    End With
  Next
End Sub

I could not run the sub when passing an argument so I just made it on big routine

 

[VBAjedi]

redjoy,

I see that you are fairly new to Tek-Tips. Welcome aboard!

Be sure to leave Skip a star if his answers helped you solve your problem (just click the link at the bottom of one of his posts, then follow the directions). It's how we say "thanks" around here.

VBAjedi