I would like to insert a blank row between each new unique identifier in column A.

[theYaniac]

The code I have works on some of the id's and not others. I am completely scratching my head. I have reached out to a few folks I know to help and they are havnig the same issue. The bank rows are not all inserted between the correct id's. Some are placed in the correct location, and some are then off by one row and then further down the column it will insert the blankn row correctly. There is no rhyme or reason that I can figure out on why it is working incorrectly on some rows and yet correctly on others. Any help would be greatly appreciated.

Sub InsertBlankRows()
Dim lastRow As Long
Dim currentRow As Long
Dim currentID As Variant
Dim previousID As Variant

'Set initial previous ID
previousID = Cells(1, 1).Value

'Find the last row with data in column A
lastRow = Cells(Rows.Count, 1).End(xlUp).Row

'Loop through each row starting from the second row
For currentRow = 2 To lastRow
currentID = Cells(currentRow, 1).Value

'If the current ID is different from the previous one, insert a blank row before the current row
If currentID <> previousID Then
Rows(currentRow).Insert Shift:=xlDown
previousID = currentID
lastRow = lastRow + 1 'Increase last row count since a new row is inserted
currentRow = currentRow + 1 'Skip the newly inserted blank row
End If

'Move to the next row
currentRow = currentRow + 1
Next currentRow
End Sub

 

[MARK858]

Try the adaption below

Sub InsertBlankRows()
    Dim lastRow As Long
    Dim currentRow As Long
    Dim currentID As Range

    'Set initial previous ID


    'Find the last row with data in column A
    lastRow = Cells(Rows.Count, 1).End(xlUp).Row

    'Loop through each row starting from the last row
    For currentRow = lastRow To 2 Step -1
        Set currentID = Cells(currentRow, 1)

        'If the current ID is different from the previous one, insert a blank row before the current row
        If currentID <> currentID.Offset(-1, 0) Then
            Rows(currentRow).Insert Shift:=xlDown
        End If

        'Move to the next row

    Next currentRow
End Sub

 

[theYaniac]

Worked perfectly. Thank you

 

[MARK858]

You're welcome (btw, I've just edited one of your comments)