Insert row everytime a cell value changes

[midoop]

Good morning,I am trying to write a VBA script that inserts a row every time a cell value changes. The number of rows that contain cell value A, for example, is a dynamic number (e.g. there's no set number of rows). Below is my code:

myrows = WorksheetFunction.CountA(ws1.Range("A:A"))For i = 2 To myrows    If Cells(i, 2) <> Cells(i + 1, 2) Then    Cells(i, 2).Select    ActiveCell.Offset(1).EntireRow.Insert    End If    Next i

This code inserts rows, but it inserts several hundreds of rows all together, and not everytime the cell value of interest changes.Any and all help is greatly appreciated!

 

[Jeffrey Lopez]

Give this guy a go, and please be sure to back up your excel workbook before running this macro!

Sub InsertRows()
  Dim lngLstRow As Long

  lngLstRow = Range("A" & Rows.Count).End(xlUp).Row
  For i = lngLstRow To 2 Step -1
    If Not IsEmpty(Range("A" & i)) Then
      If Range("A" & i) <> Range("A" & i - 1) Then
        Range("A" & i).EntireRow.Insert
      End If
    End If
  Next
End Sub

 

[midoop]

Thank you for responding! I got the following to work:

myrows = WorksheetFunction.CountA(ws1.Range("A:A"))
For i = 2 To myrows
    If Cells(i, 2) <> Cells(i - 1, 2) Then
    Rows(i).Insert xlShiftDown
    i = i + 1
    End If
    
Next i
Rows(2).Delete Shift:=xlUp

Thank you though!