How do I insert a row after several of the same batch ID, but not after unique ID's?-CodePudding

I'm looking to insert a new row after several of the same batch ID. For example, I have a vertical list in Excel: 1 2 3 3 4 5 6 6 6 7

How would I insert a new row only after the last (second) 3 and the last (third) 6? (There can be more than two or three of the same number) I have code to add a new row after each unique ID, but that does not fully support my objective. [see below]

Public Sub UniqueIDRows()
'Applies new rows under each unique value

Dim Rng As Range
Dim WorkRng As Range
Dim xTitleId As String
Dim i As Integer

On Error Resume Next
xTitleId = "Row After Batch ID"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)
Application.ScreenUpdating = False
For i = WorkRng.Rows.Count To 2 Step -1
    If WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i - 1, 1).Value Then
        WorkRng.Cells(i, 1).EntireRow.Insert
    End If
Next
Application.ScreenUpdating = True

End Sub

Any help would be much appreciated.

CodePudding user response：

Check this Sub based on your code. If you need to ignore empty cells add some check for it. I don't know what will be the size of selected range so I've made i of type Long.

Option Explicit

Public Sub UniqueIDRows()
'Applies new rows under each unique value

Dim Rng As Range
Dim WorkRng As Range
Dim xTitleId As String
Dim i As Long

Dim InsertRng As Range

'On Error Resume Next
xTitleId = "Row After Batch ID"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

'resize Range if you want to insert row after the last id if it meets condition
Set WorkRng = WorkRng.Resize(WorkRng.Rows.Count   1, WorkRng.Columns.Count)

Application.ScreenUpdating = False

'check previous cell is the same and the next cell is different
For i = 2 To WorkRng.Rows.Count - 1
    If WorkRng.Cells(i, 1).Value = WorkRng.Cells(i - 1, 1).Value And WorkRng.Cells(i, 1).Value <> WorkRng.Cells(i   1, 1).Value Then
        'rows to insert are stored in range variable
        If InsertRng Is Nothing Then
            Set InsertRng = WorkRng.Cells(i   1, 1)
        Else
            Set InsertRng = Union(InsertRng, WorkRng.Cells(i   1, 1))
        End If
    End If
Next

If Not InsertRng Is Nothing Then
    InsertRng.EntireRow.Insert
End If

Application.ScreenUpdating = True

End Sub