Parsing and Line Breaks

[csutaria]

Hi all,
I've been using the forums for several days to get answers to my questions but finally came across a dead end. Please help!

I'm working with a dataset where there is a whole bunch of text in one cell that I need to parse. There are two delimiters: "~" and ";". Furthermore, there are several line breaks within the cell, which don't necessarily indicate the need for a new cell. For example, cell A1 could look like this:

Dogs~Dogs have 4 legs.;
Humans~Humans have 2 legs.
Humans also have 2 arms.
Humans are have thumbs.;
Fish~Fish have no legs.

With this example cell A1, I would want to separate cell A1 in the following way:
B1: Dogs
C1: Dogs have 4 legs.
B2: Humans
C2: Humans~Humans have 2 legs.
Humans also have 2 arms.
Humans are have thumbs.
B3: Fish
C3: Fish have no legs.

One thing that seems to show some potential is if I run through the "text to columns" wizard setting the proper delimiters, then undo any changes that the wizard made, the file seems to remember the delimiters. From there, I can (1) select cell A1 in the example, (2) push F2, which moves my cursor inside the cell, (3) highlight all of the text, (4) select cell B1, and (5) paste.

The issue with this is that the cells organize like this:
B1: Dogs
C1: Dogs have 4 legs.
B2: Humans
C2: Humans~Humans have 2 legs.
B3: Humans also have 2 arms.
B4: Humans are have thumbs.
B5: Fish
C5: Fish have no legs.

I was thinking maybe I could design a macro with some conditional statements to move and merge cells as necessary, however, step (3) shows up in the VBA code as the actual text rather than a copy command. Plus, I'm really hoping there is a better way to do this!

Please help! Thank you in advance!

 

[Sal Paradise]

Code:

Sub Test()
    Dim i As Integer
    Dim intOffsetX As Integer
    Dim intOffsetY As Integer
    Dim intLastMatch As Integer
    
    intLastMatch = 1
    intOffsetX = 0
    intOffsetY = 1
    
    For i = 1 To Len(Cells(1, 1).Value)
        Debug.Print Cells(1, 1).Value
        If Mid(Cells(1, 1).Value, i, 1) Like "[;~]" Then
            If Mid(Cells(1, 1).Value, i, 1) = "~" Then
                Cells(1, 1).Offset(intOffsetY, 0).Value = Mid(Cells(1, 1).Value, intLastMatch, i - intLastMatch)
                intOffsetX = 1
            Else
                Cells(1, 1).Offset(intOffsetY, intOffsetX).Value = Mid(Cells(1, 1).Value, intLastMatch, i - intLastMatch)
                intOffsetY = intOffsetY + 1
                intOffsetX = intOffsetX + 1
            End If
            i = i + 1
            intLastMatch = i
        End If
    Next i
    
    Cells(1, 1).Offset(intOffsetY, intOffsetX).Value = Mid(Cells(1, 1).Value, intLastMatch, i - intLastMatch)
    
End Sub

Results:

Excel Workbook
	A	B
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.
2	Dogs	Dogs have 4 legs.
3	Humans	Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.
4	Fish	Fish have no legs.
Sheet1

 

[csutaria]

Thanks Sal! Your code splits the text exactly like how I wanted it to. I really appreciate the quick response! Now there is just one more issue that I'm having:

In the example, I gave an example of just one cell (A1) that needed to be split. In fact there are several cells similar to A1 that need to be split. They are all in column A, but there are gaps between them. What I mean is imagine a cell similar to A1 with the same delimiters, except containing different text and throughout column A (A1, A2, A4, A7,A40, etc.).

I need to be able to do a similar split to all of those cells, preferably without having to click on each cell since there are hundreds of cells like A1.

Furthermore, the example you gave puts the split cells below A1 rather than in the column to the right of A1.

Finally, if possible, I'd like to have inserted rows if they're going to take up more than one row when split. Please see the following example for clarification..

Current spreadsheet has the following cells:
A1: Dogs~Dogs have 4 legs.;
Humans~Humans have 2 legs.
Humans also have 2 arms.
Humans are have thumbs.;
Fish~Fish have no legs.

A2: Dogs~Dogs have 2 eyes.;
Humans~Humans have 2 eyes.
Humans can see color.;
Fish~Fish have 2 eyes.

A4: Dogs~A dog has fur.;
Humans~Humans have hair.;
Fish~Fish have scales.
Fish have no hair.

A10: Dogs~Dog breath smells.;
Fish~Fish don't breath.

The new spreadsheet should look like this:

A1: Dogs~Dogs have 4 legs.;
Humans~Humans have 2 legs.
Humans also have 2 arms.
Humans are have thumbs.;
Fish~Fish have no legs.
B1:Dogs
C1: Dogs have 4 legs.
B2: Humans
C2: Humans~Humans have 2 legs.
Humans also have 2 arms.
Humans are have thumbs.
B3: Fish
C3: Fish have no legs.

A4:Dogs~Dogs have 2 eyes.;
Humans~Humans have 2 eyes.
Humans can see color.;
Fish~Fish have 2 eyes.
B4: Dogs
C4: Dogs have 2 eyes.
B5: Humans
C5: Humans have 2 eyes.
Humans can see color.
B6: Fish
C6: Fish have 2 eyes.

A8:Dogs~A dog has fur.;
Humans~Humans have hair.;
Fish~Fish have scales.
Fish have no hair.
B8: Dogs
C8: A dog has fur.
B9: Humans
C9: Humans have hair.
B10: Fish
C10: Fish have scales.
Fish have no hair.

A16:Dogs~Dog breath smells.;
Fish~Fish don't breath.
B16: Dogs
C16: Dog breath smells.
B17: Fish
C17: Fish don't breath.

*Note: In the finished version, the cells are inserted so column A data shifts down

 

[Sal Paradise]

Results:

Excel Workbook
	A	B	C	D	E	F	G
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.	Dogs	Dogs have 4 legs.	Humans	Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.	Fish	Fish have no legs.
2	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.	Dogs	Dogs have 2 eyes.	Humans	Humans have 2 eyes.Humans can see color.	Fish	Fish have 2 eyes.
3	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.	Dogs	A dog has fur.	Humans	Humans have hair.	Fish	Fish have scales.Fish have no hair.
4	Dogs~Dog breath smells.;Fish~Fish don't breath.	Dogs	Dog breath smells.	Fish	Fish don't breath.
Sheet1

Code:

Sub Test()
    Dim i, j As Integer
    Dim intOffsetX As Integer
    Dim intLastMatch As Integer
    
    intLastMatch = 1
    intOffsetX = 1
    
    For j = 1 To Range("A1").End(xlDown).Row
        
        For i = 1 To Len(Cells(j, 1).Value)
            Debug.Print Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
            If Mid(Cells(j, 1).Value, i, 1) Like "[;~]" Then
                Cells(j, 1).Offset(0, intOffsetX).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
                intOffsetX = intOffsetX + 1
                i = i + 1
                intLastMatch = i
            End If
        Next i
    Cells(j, 1).Offset(intOffsetY, intOffsetX).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
    intLastMatch = 1
    intOffsetX = 1
    
    Next j
    
End Sub

 

[Sal Paradise]

Sorry, I think you wanted this:

Excel Workbook
	A	B	C	D
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.
2		Dogs	Humans	Fish
3		Dogs have 4 legs.	Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.	Fish have no legs.
4	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.
5		Dogs	Humans	Fish
6		Dogs have 2 eyes.	Humans have 2 eyes.Humans can see color.	Fish have 2 eyes.
7	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.
8		Dogs	Humans	Fish
9		A dog has fur.	Humans have hair.	Fish have scales.Fish have no hair.
10	Dogs~Dog breath smells.;Fish~Fish don't breath.
11		Dogs	Fish
12		Dog breath smells.	Fish don't breath.
Sheet1

Code:

Sub Test()
    Dim i, j As Integer
    Dim intOffsetX As Integer
    Dim intLastMatch As Integer
    Dim intLastRow As Integer
    
    intLastMatch = 1
    intOffsetX = 0
    intLastRow = Range("A1").End(xlDown).Row * 3
    
    For j = 1 To intLastRow Step 3
        Rows(j + 1).Insert
        Rows(j + 1).Insert
        
        For i = 1 To Len(Cells(j, 1).Value)
            Debug.Print Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
            If Mid(Cells(j, 1).Value, i, 1) Like "[;~]" Then
                If Mid(Cells(j, 1).Value, i, 1) = "~" Then
                    intOffsetX = intOffsetX + 1
                    Cells(j, 1).Offset(1, intOffsetX).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
                Else
                    Cells(j, 1).Offset(2, intOffsetX).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
                End If
                i = i + 1
                intLastMatch = i
            End If
        Next i
    Cells(j, 1).Offset(2, intOffsetX).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
    intLastMatch = 1
    intOffsetX = 0
    
    Next j
    
End Sub

 

[csutaria]

Hi Sal,

Actually, you were closer with your second post. However, Columns D:G need to have their data align under Column B:C. Please see the visuals below. Note that the number of empty rows between data sets remains the same.

I tried recording another macro and adding in "If ... then..." logic, but still no luck. Thanks again so much for your help and I would appreciate any additional assistance you can give me.

On a side note, do you have any recommendations for materials that will teach me more about VBA coding?

Here is how it looks originally:

Excel Workbook
	A	B	C
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.	*	*
2	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.	*	*
3	*	*	*
4	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.	*	*
5	*	*	*
6	*	*	*
7	*	*	*
8	*	*	*
9	*	*	*
10	Dogs~Dog breath smells.;Fish~Fish don't breath.	*	*
Sheet1

Here is an example of what it should ultimately look like:

Excel Workbook
	A	B	C
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.	Dogs	Dogs have 4 legs.
2	*	Humans	Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.
3	*	Fish	Fish have no legs.
4	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.	Dogs	Dogs have 2 eyes.
5	*	Humans	Humans have 2 eyes.Humans can see color.
6	*	Fish	Fish have 2 eyes.
7	*	*	*
8	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.	Dogs	A dog has fur.
9	*	Humans	Humans have hair.
10	*	Fish	Fish have scales.Fish have no hair.
11	*	*	*
12	*	*	*
13	*	*	*
14	*	*	*
15	*	*	*
16	Dogs~Dog breath smells.;Fish~Fish don't breath.	Dogs	Dog breath smells.
17	*	Fish	Fish don't breath.
Sheet1

 

[csutaria]

I'm not sure why "*" are appearing in the empty cells in my visual, but that shouldn't happen. The cells should be entirely empty.

Hi Sal,

Actually, you were closer with your second post. However, Columns D:G need to have their data align under Column B:C. Please see the visuals below. Note that the number of empty rows between data sets remains the same.

I tried recording another macro and adding in "If ... then..." logic, but still no luck. Thanks again so much for your help and I would appreciate any additional assistance you can give me.

On a side note, do you have any recommendations for materials that will teach me more about VBA coding?

Here is how it looks originally:

Excel Workbook
	A	B	C
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.	*	*
2	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.	*	*
3	*	*	*
4	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.	*	*
5	*	*	*
6	*	*	*
7	*	*	*
8	*	*	*
9	*	*	*
10	Dogs~Dog breath smells.;Fish~Fish don't breath.	*	*
Sheet1

Here is an example of what it should ultimately look like:

Excel Workbook
	A	B	C
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.	Dogs	Dogs have 4 legs.
2	*	Humans	Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.
3	*	Fish	Fish have no legs.
4	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.	Dogs	Dogs have 2 eyes.
5	*	Humans	Humans have 2 eyes.Humans can see color.
6	*	Fish	Fish have 2 eyes.
7	*	*	*
8	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.	Dogs	A dog has fur.
9	*	Humans	Humans have hair.
10	*	Fish	Fish have scales.Fish have no hair.
11	*	*	*
12	*	*	*
13	*	*	*
14	*	*	*
15	*	*	*
16	Dogs~Dog breath smells.;Fish~Fish don't breath.	Dogs	Dog breath smells.
17	*	Fish	Fish don't breath.
Sheet1

 

[Sal Paradise]

Start with this:

Excel Workbook
	A
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.
2	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.
3
4	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.
5
6
7
8
9
10	Dogs~Dog breath smells.;Fish~Fish don't breath.
Sheet1

Get this:

Excel Workbook
	A	B	C
1	Dogs~Dogs have 4 legs.;Humans~Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.;Fish~Fish have no legs.	Dogs	Dogs have 4 legs.
2		Humans	Humans have 2 legs.Humans also have 2 arms.Humans are have thumbs.
3		Fish	Fish have no legs.
4	Dogs~Dogs have 2 eyes.;Humans~Humans have 2 eyes.Humans can see color.;Fish~Fish have 2 eyes.	Dogs	Dogs have 2 eyes.
5		Humans	Humans have 2 eyes.Humans can see color.
6		Fish	Fish have 2 eyes.
7
8	Dogs~A dog has fur.;Humans~Humans have hair.;Fish~Fish have scales.Fish have no hair.	Dogs	A dog has fur.
9		Humans	Humans have hair.
10		Fish	Fish have scales.Fish have no hair.
11
12
13
14
15
16	Dogs~Dog breath smells.;Fish~Fish don't breath.	Dogs	Dog breath smells.
17		Fish	Fish don't breath.
Sheet1

Code:

Sub Test()
    Dim i, j As Integer
    Dim intOffsetY As Integer
    Dim intLastMatch As Integer
    Dim intLastRow As Integer
    
    intLastMatch = 1
    intOffsetY = 0
    intLastRow = Range("A65535").End(xlUp).Row * 3
    
    For j = 1 To intLastRow
        
        If Len(Cells(j, 1).Value) > 1 Then
            
            For i = 1 To Len(Cells(j, 1).Value)
                Debug.Print Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
                If Mid(Cells(j, 1).Value, i, 1) Like "[;~]" Then
                    If Mid(Cells(j, 1).Value, i, 1) = "~" Then
                        Cells(j, 1).Offset(intOffsetY, 1).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
                    Else
                        Cells(j, 1).Offset(intOffsetY, 2).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
                        intOffsetY = intOffsetY + 1
                        Rows(j + intOffsetY).Insert
                    End If
                    i = i + 1
                    intLastMatch = i
                End If
            Next i
            Cells(j, 1).Offset(intOffsetY, 2).Value = Mid(Cells(j, 1).Value, intLastMatch, i - intLastMatch)
            intLastMatch = 1
            intOffsetY = 0
        End If
    
    Next j
    
End Sub