MACRO to Insert row in 'D' col after name changed.

Hi,Team

I need macro to insert blank row in D col after name changed for specific range or from specific row
I have attached sample file, Below is macro code which is used for inserting blank row.

Sub InsertBRow()
    Dim iRow    As Long

    iRow = 3
    Do
        With Cells(iRow, "D")
            If IsEmpty(.Value) Then Exit Do
            If .Offset(-1).Value <> .Value Then
                .EntireRow.Insert
                iRow = iRow + 2
            Else
                iRow = iRow + 1
            End If
        End With
    Loop
End Sub

Thanks in advance

Hi visha_1984, try the following:

Sub InsertRows()
    
    Dim ws1 As Worksheet
    Dim dRng As Range
    Dim oC As Range
    
    Application.ScreenUpdating = False
    Set ws1 = Worksheets("Sheet1")
    Set dRng = ws1.Range(ws1.Cells(1, 4), ws1.Cells(ws1.Rows.Count, 4).End(xlUp))
    For Each oC In dRng
        If oC.Offset(1, 0).Value <> oC.Value And oC.Value <> "" Then
            oC.Offset(1, 0).EntireRow.Insert xlUp
        End If
    Next oC
    Application.ScreenUpdating = True
    
End Sub

Hi Mordred

Thanks for reply

your code is working perfectly but it inserts blank row in whole sheet again which are allready been inserted , But i want macro to insert row which are not inserted in the same col before.

Sorry, the following should now do the trick

Sub InsertRows()
    
    Dim ws1 As Worksheet
    Dim dRng As Range
    Dim oC As Range
    
    Application.ScreenUpdating = False
    Set ws1 = Worksheets("Sheet1")
    Set dRng = ws1.Range(ws1.Cells(1, 4), ws1.Cells(ws1.Rows.Count, 4).End(xlUp))
    For Each oC In dRng
        If oC.Offset(1, 0).Value <> oC.Value And oC.Offset(1, 0).Value <> "" And oC.Value <> "" Then
            oC.Offset(1, 0).EntireRow.Insert xlUp
        End If
    Next oC
    Application.ScreenUpdating = True
    
End Sub

Perfect.

Thank u very much Mordred

Good Day

You are most welcome and have a great day too!