VBA to split report according to segmentation of rows unique values to sheet check

Hi John

This Code is inModule1 of the attached and appears to do as you require...

Option Explicit

Sub Split_Column_AA()
   Dim ws           As Worksheet
   Dim ws1          As Worksheet
   Dim LR1          As Long
   Dim i            As Long
   Dim Rng          As Range

   
   Application.ScreenUpdating = False
   Set ws = Sheets("LOB")
   If Not Evaluate("ISREF(Output!A1)") Then
      Worksheets.Add(After:=ws).Name = "Output"
   Else
      Sheets("Output").Cells.Clear
   End If

   Set ws1 = Sheets("Output")

   ws.Cells.Copy
   ws1.Range("A1").PasteSpecial
   With ws1
      LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
      .Range("A2:AA" & LR1).Sort key1:=.Range("AA2"), order1:=xlAscending
      Set Rng = .Range("AA2:AA" & LR1)
      With Rng
         For i = LR1 To 2 Step -1
            If Not Rng(i).Value = Rng(i).Offset(-1, 0).Value Then
               Rng(i).EntireRow.Insert
            End If
         Next i
      End With
      LR1 = .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious).Row
      Set Rng = .Range("A2:A" & LR1)

      Rng.SpecialCells(xlCellTypeBlanks).Select
      .Range("A1:AA1").Copy
      Selection.PasteSpecial
      Application.CutCopyMode = False
      With Rng
         For i = LR1 To 2 Step -1
            If Rng(i).Value = "Row ID" Then
               Rng(i).Resize(2, 1).EntireRow.Insert
            End If
         Next i
      End With
   End With
   Application.ScreenUpdating = True
End Sub

Hi John

you had it mostly correct except this line of Code...

If Rng(i).Value = "Source" Then

should be...

If Rng(i).Value = "Row ID" Then

You're welcome...glad I could help.

If you're satisfied by any members response to your issue please use the star icon at the lower left of their post.