Insert a blank row when the data in a column changes

[gomes123]

In column B (5000+ rows long), I have a macro to insert a blank row whenever the value in Column B changes.

Sub InsertNewRowAtChange()    
Dim lastRow As Long   
 Dim i As Long     
   lastRow = Cells(Rows.Count, "A").End(xlUp).Row     
   For i = lastRow To 2 Step -1     
   If Range("A" & i).Value <> Range("A" & i - 1).Value Then     
       Rows(i).Insert Shift:=xlDown       
 End If   
 Next i
End Sub

The problem is that it is taking quite a long time.

Is there anyway to optimise the macro to make it more efficient/run faster? Thanks.

 

[Peter_SSs]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Bit of confusion because your description talks about inserting a row the value in col B changes but your code does it when col A changes.

Give this a try with a copy of your data. I have assumed the changes are in col A.

Sub Insert_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, z As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  z = UBound(a)
  ReDim b(1 To Rows.Count, 1 To 1)
  b(1, 1) = 0
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      z = z + 1
      b(z, 1) = k
      k = k + 1
    End If
    b(i, 1) = k
  Next i
  Application.ScreenUpdating = False
  With Range("A1").Resize(z, nc)
    .Columns(nc).Value = b
    .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
    .Columns(nc).ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

 

[gomes123]

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Bit of confusion because your description talks about inserting a row the value in col B changes but your code does it when col A changes.

Give this a try with a copy of your data. I have assumed the changes are in col A.

Sub Insert_Rows()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long, z As Long
 
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  a = Range("A1", Range("A" & Rows.Count).End(xlUp)).Value
  z = UBound(a)
  ReDim b(1 To Rows.Count, 1 To 1)
  b(1, 1) = 0
  For i = 2 To UBound(a)
    If a(i, 1) <> a(i - 1, 1) Then
      z = z + 1
      b(z, 1) = k
      k = k + 1
    End If
    b(i, 1) = k
  Next i
  Application.ScreenUpdating = False
  With Range("A1").Resize(z, nc)
    .Columns(nc).Value = b
    .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
    .Columns(nc).ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

Noted and thanks for the prompt, I have updated my excel version & platform. And yes, its Column A, sorry!

Thanks for your solution too! I ran the macro and in "an instant" the blank rows were all added.

However, there is a minor hiccup, where the original data (assume its 5000 rows) has formatting on it (borders, conditional formatting), and after running your code, all the rows after row 5000 has lost all its formatting. Is there a way to solve this? Thanks

 

[Peter_SSs]

I have updated my excel version & platform.

Great, thanks for that.

Thanks for your solution too! I ran the macro and in "an instant" the blank rows were all added.

You're welcome. Thanks for the confirmation.

However, there is a minor hiccup, where the original data (assume its 5000 rows) has formatting on it (borders, conditional formatting), and after running your code, all the rows after row 5000 has lost all its formatting. Is there a way to solve this? Thanks

If you want the speed of the row insertion then you will probably have to have the macro apply the formatting to the whole range. It depends a bit what that formatting is. It may be simpler to remove all formatting and apply new formatting to the expanded range. If you need help with that we would need details about the formatting and about the data layout generally.