Insert row to separates group of data with header

Question

Would anyone will be able to help me with this script please?

As it stand, this current macro separate the data once the value/text have changes and insert new row but I just cannot work it out how to include the headers once the row have been inserted.

Sub Insert Row()

Dim ws As Worksheet
Dim lr As Long
Dim i As Long

Set ws = Worksheets("Sheet1") 'the sheet with the data
lr = ws.Range("A" & Rows.Count).End(xlUp).Row 'last row with data in Column A
For i = lr - 1 To 2 Step -1
If ws.Range("A" & i).Value <> ws.Range("A" & i + 1).Value Then ws.Range("A" & i + 1).EntireRow.Insert
Next i

End Sub

Thank you in advanced.

Take a look at this. To get the gap (empty row), duplicate durg.EntireRow.Insert xlShiftDown in the final If statement. If the 2nd column is the one you're splitting the data in, use drg.Columns(2).Cells. — VBasic2008
– VBasic2008, Commented Jan 16, 2023 at 8:01
Off topic formula solution: =DROP(DROP(REDUCE(0,ROW(A2:C3),LAMBDA(x,y,VSTACK(x,A1:C1,INDEX(A:C,y,),{"","",""}))),1,),-1) — P.b
– P.b, Commented Jan 16, 2023 at 8:03
@VBasic2008 that doesn't work for me as I have multiple worksheets :( — TK4795
– TK4795, Commented Jan 16, 2023 at 8:08
To avoid system language array notation errors: =DROP(DROP(IFERROR(REDUCE(0,ROW(A2:C3),LAMBDA(x,y,VSTACK(x,A1:C1,INDEX(A:C,y,),""))),""),1),-1) — P.b
– P.b, Commented Jan 16, 2023 at 8:58
@VBasic2008: sorry, I meant a horizontal array. For the German configuration only a dot (.) works - backslash throws an error (as with a comma (,). For a vertical array we have to use a semicolon (;). — Ike
– Ike, Commented Jan 16, 2023 at 9:49

VBasic2008 · Accepted Answer · 2023-01-16 12:17:16Z

2

Duplicate Headers

A Quick Fix

Sub InsertHeaders()

    Const FIRST_ROW As Long = 1
    Const EMPTY_ROWS As Long = 1
    
    Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Sheet1")
    Dim LastRow As Long: LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    Dim r As Long
    
    For r = LastRow To FIRST_ROW + 2 Step -1
        With ws.Cells(r, "A")
            If .Value <> .Offset(-1).Value Then
                .EntireRow.Resize(EMPTY_ROWS + 1).Insert
                ws.Rows(1).Copy ws.Rows(.Row - 1)
            End If
        End With
    Next r

End Sub

answered Jan 16, 2023 at 12:17

VBasic2008

56.8k5 gold badges21 silver badges38 bronze badges

Sign up to request clarification or add additional context in comments.

Comments

karma · Accepted Answer · 2023-01-16 15:47:30Z

0

Please ignore my comment, as I just realize that it will be a different result if in column A there is a cell with the same value.

Example Data :

Expected result after running the sub :

Sub test()
Dim rgHdr As Range: Dim rgData As Range: Dim cell As Range
Dim i As Integer: Dim arr: Dim ins As Integer:dim sh as worksheet

Set sh = Sheets("Sheet1") 'change if needed
ins = 3 'change if needed

With sh
    .Range("A1").EntireRow.Resize(ins).Insert Shift:=xlDown
    Set rgHdr = .Range("A1").EntireRow.Resize(1 + ins)
    Set rgData = .Range("K" & 2 + ins, .Range("K" & Rows.Count).End(xlUp))
End With

Set arr = CreateObject("scripting.dictionary")
For Each cell In rgData: arr.Item(cell.Value) = 1: Next

For i = 1 To arr.Count - 1
    rgHdr.Copy
    sh.Cells(rgData.Find(arr.Keys()(i), _
      after:=rgData.End(xlDown)).Row, 1).Insert Shift:=xlDown
Next
    
sh.Range("A1").EntireRow.Resize(ins).Delete
End Sub

sh = the sheets where the data is.
ins = skip how many blank rows.

The code use "insert copied cells" method, so it make three blank rows (the value of ins) before the header, then set the first three rows as rgHdr, set the rgData from K2 down to the last row with value.

arr = unique value in column K.

then it loop to each element in arr, get the first row occurence of the found cell which value is the looped element in arr, insert the copied rgHdr to that row.

Then finally it delete those three (ins value is 3) additional blank rows.

edited Jan 16, 2023 at 15:47

answered Jan 16, 2023 at 9:20

karma

2,0091 gold badge12 silver badges17 bronze badges

2 Comments

TK4795 Over a year ago

Thank you so much, the code works but it doesn't includes all the information in other cell, I have to change the range to K as my column A is a blank as I still need them for later data. The code doesn't delete the previous data, it just putting the information underneath it? Thank you for your help.

karma Over a year ago

@TK4795, Sorry, in your image I see that your data is across 3 columns and start from cell A2. So the code follow the data based on the kind of data and the expected result just like in your image attachment. Please have a look to the updated code which this time it will retain all of columns value because it use the whole row value (doesn't care with the column).

Collectives™ on Stack Overflow

Insert row to separates group of data with header

2 Answers 2

Duplicate Headers

Comments

2 Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Duplicate Headers

Comments

2 Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related