Add a blank row to a table in-between each unique values

[gheyman]

I have a table (table1) on sheet1. in the very first column [ItemID] I have a list of parts where there are many duplicates (which is to be expected). Is there a way to instert a blank row where the part number does not eaqual the or is not the same as the row above it?

Thanks

 

[kanadaaa]

Try this in a standard module:

Sub test()
    Dim rng As Range, nextRng As Range
    Set rng = Range("A:A").Find(Cells(1, 1).Value, , xlValues, xlWhole, xlByRows, xlPrevious)
    Do While Not IsEmpty(rng.Offset(1, 0))
    If rng.Offset(1, 0) <> rng Then
        Set nextRng = rng.Offset(1, 0)
        nextRng.Insert Shift:=xlDown
        Set rng = Range("A:A").Find(nextRng.Value, , xlValues, xlWhole, xlByRows, xlPrevious)
    End If
    Loop
End Sub

Note that this only works if the upper leftmost cell in the table is A1.

 

[Akuini]

Another option:

Sub a1160395a()
'https://www.mrexcel.com/board/threads/add-a-blank-row-to-a-table-in-between-each-unique-values.1160395/
Dim i As Long
Application.ScreenUpdating = False

With ActiveSheet.ListObjects("Table1").Range.Columns(1)
    For i = .Rows.Count + 1 To 3 Step -1
        Do
            i = i - 1
            If i = 2 Then Exit For
        Loop While .Cells(i) = .Cells(i - 1)
            .Rows(i).Insert
            i = i + 1
    Next
End With

Application.ScreenUpdating = True
End Sub

 

[gheyman]

Thank you both. I tried both and they both work. Very much appreciate your time and help!

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.