Splitting a row into two when a certain substring is found

For an accurate macro solution to be suggested the first time, you should provide an accurate sample workbook, not something dumbed down too far. Click GO ADVANCED and use the paperclip icon to post up a copy of your workbook.

Make sure the sample workbook fully demonstrates the needs, and BEFORE/AFTER results make it easiest.

lifeseeker1019,

I assume that there would be only one Notes: in a cell in column A.


If you just have data in column A, try the following macro:


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, by highlighting the code and pressing the keys CTRL + C
2. Open your 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 by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.

Option Explicit
Sub SplitOnNotes()
' stanleydgromjr, 04/17/2011
' http://www.excelforum.com/excel-programming/772780-splitting-a-row-into-two-when-a-certain-substring-is-found.html
Dim LR As Long, a As Long, Sp
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
For a = LR To 1 Step -1
  If InStr(Cells(a, 1), "Notes:") > 0 Then
    Sp = Split(Cells(a, 1), "Notes:")
    Cells(a, 1).Offset(1).Rows.Insert
    Cells(a, 1) = Sp(0)
    Cells(a, 1).Offset(1) = "Notes:" & Sp(1)
  End If
Next a
Application.ScreenUpdating = True
End Sub

Then run the SplitOnNotes macro.





If there are more columns, and you want to duplicate the ROW that contains Notes: in column A, try the following macro:


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).

Sub SplitOnNotesV2()
' stanleydgromjr, 04/17/2011
' http://www.excelforum.com/excel-programming/772780-splitting-a-row-into-two-when-a-certain-substring-is-found.html
Dim LR As Long, a As Long, Sp
Application.ScreenUpdating = False
LR = Cells(Rows.Count, 1).End(xlUp).Row
For a = LR To 1 Step -1
  If InStr(Cells(a, 1), "Notes:") > 0 Then
    Sp = Split(Cells(a, 1), "Notes:")
    Rows(a).Offset(1).Insert
    Rows(a).Copy Rows(a + 1)
    Cells(a, 1) = Sp(0)
    Cells(a, 1).Offset(1) = "Notes:" & Sp(1)
  End If
Next a
Application.ScreenUpdating = True
End Sub

Then run the SplitOnNotesV2 macro.

Hello lifeseeker1019,

Here is another method. This will copy the split rows and single rows to a different worksheet leaving the original data intact. However, it is design to operate only a single column. You can easily change the starting rows of the both the destination and source worksheet and the worksheet used for each. Both are set to start with cell "A2". This assumes there are headers in row 1.

Sub SplitIntoRows()

  Dim Cell As Range
  Dim DstRng As Range
  Dim R As Long
  Dim RegExp As Object
  Dim Rng As Range
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet1")
    Set Rng = Wks.Range("A2")
    
    Set DstRng = Worksheets("Sheet2").Range("A2")
        
    Set RngEnd = Wks.Cells(Rows.Count, Rng.Column).End(xlUp)
    If RngEnd.Row < Rng.Row Then Exit Sub Else Set Rng = Wks.Range(Rng, RngEnd)
    
      Set RegExp = CreateObject("VBScript.RegExp")
      RegExp.IgnoreCase = True
      RegExp.Pattern = "(.*)(Notes\:.*)"
      
      
        For Each Cell In Rng
          DstRng.Offset(R, 0) = RegExp.Replace(Cell, "$1")
            If RegExp.Test(Cell) Then
              R = R + 1
              DstRng.Offset(R, 0) = RegExp.Replace(Cell, "$2")
            End If
          R = R + 1
        Next Cell
      
End Sub