Split all cells before lines that contains a specific string and create new rows.

[topi1]

Is it possible to have a vba which looks at a column, and then adds rows before every line that contains a specific string, in my example "shows". Everything else is kept in the same row unless a new line with the specific string occurs. Thank you. I have looked hard about adding rows above and below. I have found ways with single words and single occurrences but not for anything like I am hoping for. Thank you for everyone's help here.

Before

Book1
	A
1	Page 1 shows a large picture. Picture is of a baby. Page 2 shows a cartoon. It is from far side. Page 3 shows today's news.
2
3	Page 4 shows sports. Mostly NFL. Page 5 shows ads.
Sheet1

After

Book1
	A
1	Page 1 shows a large picture. Picture is of a baby.
2
3	Page 2 shows a cartoon. It is from far side.
4
5	Page 3 shows today's news.
6
7	Page 4 shows sports. Mostly NFL.
8
9	Page 5 shows ads.
Sheet2

 

[DanteAmor]

and then adds rows before every line that contains a specific string

Modify the specific string in the data highlighted in blue in the macro.

Sub split_line()
  Dim c As Range
  Dim s As Variant
  Dim i As Long
  Dim myStr As String
 
  myStr = "Page"
  i = 1
  For Each c In Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A" & Rows.Count).End(3))
    If c.Value <> "" Then
      For Each s In Split(c.Value, myStr, , vbTextCompare)
        If s <> "" Then
          Sheets("Sheet2").Range("A" & i).Value = myStr & s
          i = i + 2
        End If
      Next
    End If
  Next
End Sub

 

[topi1]

@DanteAmor thank you as always for your prompt help. I modified Mystr as you instructed and used the following code and I am getting the following results, different than what I am hoping for. Thank you.

Sub split_line()
  Dim c As Range
  Dim s As Variant
  Dim i As Long
  Dim myStr As String
 
  myStr = "shows"
  i = 1
  For Each c In Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A" & Rows.Count).End(3))
    If c.Value <> "" Then
      For Each s In Split(c.Value, myStr, , vbTextCompare)
        If s <> "" Then
          Sheets("Sheet2").Range("A" & i).Value = myStr & s
          i = i + 2
        End If
      Next
    End If
  Next
End Sub

Book2
	A
1	showsPage 1
2
3	shows a large picture. Picture is of a baby. Page 2
4
5	shows a cartoon. It is from far side. Page 3
6
7	shows today's news.
8
9	showsPage 4
10
11	shows sports. Mostly NFL. Page 5
12
13	shows ads.
Sheet2

 

[DanteAmor]

Edit.

I got ahead of the tests.

 

[topi1]

Try:
It works as long as each sentence has a dot "." in the phrase.

Sub split_line()
  Dim c As Range
  Dim s As Variant
  Dim i As Long
  Dim myStr As String
 
  myStr = "shows"
  i = 1
  For Each c In Sheets("Sheet1").Range("A1", Sheets("Sheet1").Range("A" & Rows.Count).End(3))
    For Each s In Split(c.Value, ".", , vbTextCompare)
      If InStr(1, s, myStr, vbTextCompare) > 0 Then
        Sheets("Sheet2").Range("A" & i).Value = Trim(s) & "."
        i = i + 2
      End If
    Next
  Next
End Sub

Thank you but it removes sentences that do not contain the specific string. e.g. "Picture is of a baby."

 

[DanteAmor]

I think I have it, try this:

Sub split_line()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim c As Range
  Dim s As Variant
  Dim i As Long, ini As Long
  Dim myStr As String
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  ini = 1
  myStr = "shows"
  
  
  i = ini
  For Each c In sh1.Range("A1", sh1.Range("A" & Rows.Count).End(3))
    For Each s In Split(c.Value, ".", , vbTextCompare)
      If Trim(s) <> "" Then
        If InStr(1, s, myStr, vbTextCompare) > 0 Then
          If sh2.Range("A" & i).Value = "" Then
            sh2.Range("A" & i).Value = Trim(s) & "."
          Else
            sh2.Range("A" & i).Value = sh2.Range("A" & i).Value & s & "."
          End If
          i = i + 2
        Else
          If i = ini Then
            sh2.Range("A" & ini).Value = sh2.Range("A" & ini).Value & s & "."
          Else
            sh2.Range("A" & i - 2).Value = sh2.Range("A" & i - 2).Value & s & "."
          End If
        End If
      End If
    Next
  Next
End Sub

 

[topi1]

I think I have it, try this:

Sub split_line()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim c As Range
  Dim s As Variant
  Dim i As Long, ini As Long
  Dim myStr As String
 
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  ini = 1
  myStr = "shows"
 
 
  i = ini
  For Each c In sh1.Range("A1", sh1.Range("A" & Rows.Count).End(3))
    For Each s In Split(c.Value, ".", , vbTextCompare)
      If Trim(s) <> "" Then
        If InStr(1, s, myStr, vbTextCompare) > 0 Then
          If sh2.Range("A" & i).Value = "" Then
            sh2.Range("A" & i).Value = Trim(s) & "."
          Else
            sh2.Range("A" & i).Value = sh2.Range("A" & i).Value & s & "."
          End If
          i = i + 2
        Else
          If i = ini Then
            sh2.Range("A" & ini).Value = sh2.Range("A" & ini).Value & s & "."
          Else
            sh2.Range("A" & i - 2).Value = sh2.Range("A" & i - 2).Value & s & "."
          End If
        End If
      End If
    Next
  Next
End Sub

@DanteAmor Fantastic! Amazing, works exactly. However, I can think of slightly different scenarios in which case this code will not work as is. I would greatly appreciate it if it can be modified to accommodate that. My bad... I should have thought of it right at the outset. Following show data before and after this code is run. It also grabs items from another row if it does not have a specific MyStr. I want to keep them separate as demonstrated in desired output.

Before

Book4
	A
1	Page 1 shows a large picture. Picture is of a baby. Page 2 shows a cartoon. It is from far side. Page 3 shows today's news.
2
3	Breaking News
4
5	Page 4 shows sports. Mostly NFL. Page 5 shows ads.
6
7	Good News.
8
9	Trash News.
Sheet1

After

Book4
	A
1	Page 1 shows a large picture. Picture is of a baby.
2
3	Page 2 shows a cartoon. It is from far side.
4
5	Page 3 shows today's news.Breaking News.
6
7	Page 4 shows sports. Mostly NFL.
8
9	Page 5 shows ads.Good News.Trash News.
Sheet2

Desired Output

Book4
	N
1	Page 1 shows a large picture. Picture is of a baby.
2
3	Page 2 shows a cartoon. It is from far side.
4
5	Page 3 shows today's news.
6
7	Breaking News.
8
9	Page 4 shows sports. Mostly NFL.
10
11	Page 5 shows ads.
12
13	Good News.
14
15	Trash News.
Sheet2

 

[DanteAmor]

varios 20ene2024.xlsm
	D	E
8	Page 2 shows a cartoon. It is from far side.	Page 2 shows a cartoon. It is from far side.
9
10	Page 3 shows today's news.Breaking News.	Page 3 shows today's news.
11
12		Breaking News.
Sheet2

But what is the pattern to identify when it belongs to the same row and when it goes to another row?

 

[topi1]

varios 20ene2024.xlsm
	D	E
8	Page 2 shows a cartoon. It is from far side.	Page 2 shows a cartoon. It is from far side.
9
10	Page 3 shows today's news.Breaking News.	Page 3 shows today's news.
11
12		Breaking News.
Sheet2

But what is the pattern to identify when it belongs to the same row and when it goes to another row?

Rows which do not have a string, in this case "shows", remain untouched. Thank you. In the example, there are three of them. Thank you.

 

[DanteAmor]

Rows which do not have a string, in this case "shows", remain untouched.

ah ok.


Try:

Sub split_line()
  Dim sh1 As Worksheet, sh2 As Worksheet
  Dim c As Range
  Dim s As Variant
  Dim i As Long, ini As Long
  Dim myStr As String
  
  Set sh1 = Sheets("Sheet1")
  Set sh2 = Sheets("Sheet2")
  ini = 1
  myStr = "shows"
  
  
  i = ini
  For Each c In sh1.Range("A1", sh1.Range("A" & Rows.Count).End(3))
    If InStr(1, c.Value, myStr, vbTextCompare) = 0 And c.Value <> "" Then
      sh2.Range("A" & i).Value = c.Value
      i = i + 2
    Else
    
      For Each s In Split(c.Value, ".", , vbTextCompare)
        If Trim(s) <> "" Then
          If InStr(1, s, myStr, vbTextCompare) > 0 Then
            If sh2.Range("A" & i).Value = "" Then
              sh2.Range("A" & i).Value = Trim(s) & "."
            Else
              sh2.Range("A" & i).Value = sh2.Range("A" & i).Value & s & "."
            End If
            i = i + 2
          Else
            If i = ini Then
              sh2.Range("A" & ini).Value = sh2.Range("A" & ini).Value & s & "."
            Else
              sh2.Range("A" & i - 2).Value = sh2.Range("A" & i - 2).Value & s & "."
            End If
          End If
        End If
      Next
    End If
  Next
End Sub