Insert a blank row when the cell in column "B" changes.

harzer

Board Regular
Joined
Dec 15, 2021
Messages
153
Office Version
  1. 2016
Platform
  1. Windows
Hello everyone,
I found the following code which allows me to insert an empty line each time the value of my cell in column "B" changes, of course, this code does the job but only given the size of the data, it takes a while to run, how can we modify it to optimize it, or even replace it with code that uses arrays (UBound) so that it is faster.
Thanks in advance for your suggestions.

VBA Code:
Sub Insert_Rows()

         '''Trier le tableau (A2:L & derniere) ligne sur la colonne "B" avant d'inserer les lignes
        Range("A2:L" & Range("B" & Rows.Count).End(xlUp).Row).Sort _
            key1:=Range("B2"), order1:=xlAscending, Header:=xlNo
    

    Dim ws As Worksheet, x As Long, LastRow As Long
        Set ws = ActiveSheet

        With ws
            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row

                For x = LastRow - 1 To 2 Step -1
                        If .Cells(x, "B").Value <> .Cells(x + 1, "B").Value Then
                                .Rows(x + 1).Insert
                        End If
                Next

            LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        End With
End Sub

Unsorted array :

Classeur2.xlsm
ABCDEFGHIJKL
1JeunePèreMèreEleveurAgeVolièreCageNé(e)ToursInformationElevageN° Ligne
2AEY27 093/2012 MAET27-093/2022 MAE27-093/2012 MGérard Claude10a 11m 28j2B168-06-20124T1
3AE27-094/2012 MAE27-093/2012 MAE27-094/2012 MGérard Claude10a 11m 28j2B168-06-20124Tx2
4HTY0127 100/2012 FAE27-093/2012 MAE27-100/2012 FGérard Claude10a 11m 26j2B1310-06-20124T3
5AE27-059/2013 FAE27-059/2013 FAE27-059/2013 FGérard Claude10a 1m 11j3H1325-04-20134Tx4
6AE27060/2013 MAE27-059/2013 FAE27-060/2013 MGérard Claude10a 0m 31j5H195-05-20135T5
7AE27-084/2013 MAE27-084/2013 MAE27-084/2013 MGérard Claude10a 0m 17j3H1619-05-20134T6
8AE27085/2013 MAE27-084/2013 MAE27-085/2013 MGérard Claude10a 0m 18j5H2118-05-20134Tx7
9AE27 086/2013 FAE27-084/2013 MAE27-086/2013 FGérard Claude9a 11m 9j2B2127-06-20134T8
10AE27-087/2013 FAE27-087/2013 FAE27-087/2013 FGérard Claude10a 0m 18j5H2218-05-20134Tx9
11AE27011/2019 FAE27-087/2013 FAE27-011/2019 FGérard Claude4a 1m 14j4H1122-04-20195Tx10
12AE27012/2019 FAE27-087/2013 FAE27-012/2019 FGérard Claude4a 1m 14j5H1122-04-20195Tx11
13AE27013/2019 MAE27-013/2019 MAE27-013/2019 MGérard Claude4a 1m 14j4H122-04-20194Tx12
14AE27014/2019 FAE27-014/2019 FAE27-014/2019 FGérard Claude4a 1m 16j4H220-04-20194T13
15AE27015/2019 MAE27-014/2019 FAE27-015/2019 MGérard Claude4a 1m 17j4H619-04-20194Tx14
16AE27 017/2019 FAE27-017/2019 FAE27-017/2019 FGérard Claude4a 1m 17j3H619-04-20194T15
17AE27-042/2022 MAE27-042/2022 MAE27-042/2022 MGérard Claude0a 11m 18j5H618-06-20224Tx16
18AE27 043/2022 FAE27-042/2022 MAE27-043/2022 FGérard Claude0a 11m 18j4H618-06-20224Tx17
Résultat


Unless I am mistaken, here is the table sorted on column "B" with rows inserted :

Classeur2.xlsm
ABCDEFGHIJKL
1JeunePèreMèreEleveurAgeVolièreCageNé(e)ToursInformationElevageN° Ligne
2AE27013/2019 MAE27-013/2019 MAE27-013/2019 MGérard Claude4a 1m 14j4H122-04-20194Tx12
3
4AE27014/2019 FAE27-014/2019 FAE27-014/2019 FGérard Claude4a 1m 16j4H220-04-20194T13
5AE27015/2019 MAE27-014/2019 FAE27-015/2019 MGérard Claude4a 1m 17j4H619-04-20194Tx14
6
7AE27 017/2019 FAE27-017/2019 FAE27-017/2019 FGérard Claude4a 1m 17j3H619-04-20194T15
8
9AE27-042/2022 MAE27-042/2022 MAE27-042/2022 MGérard Claude0a 11m 18j5H618-06-20224Tx16
10AE27 043/2022 FAE27-042/2022 MAE27-043/2022 FGérard Claude0a 11m 18j4H618-06-20224Tx17
11
12AE27-059/2013 FAE27-059/2013 FAE27-059/2013 FGérard Claude10a 1m 11j3H1325-04-20134Tx4
13AE27060/2013 MAE27-059/2013 FAE27-060/2013 MGérard Claude10a 0m 31j5H195-05-20135T5
14
15AE27-084/2013 MAE27-084/2013 MAE27-084/2013 MGérard Claude10a 0m 17j3H1619-05-20134T6
16AE27085/2013 MAE27-084/2013 MAE27-085/2013 MGérard Claude10a 0m 18j5H2118-05-20134Tx7
17AE27 086/2013 FAE27-084/2013 MAE27-086/2013 FGérard Claude9a 11m 9j2B2127-06-20134T8
18
19AE27-087/2013 FAE27-087/2013 FAE27-087/2013 FGérard Claude10a 0m 18j5H2218-05-20134Tx9
20AE27011/2019 FAE27-087/2013 FAE27-011/2019 FGérard Claude4a 1m 14j4H1122-04-20195Tx10
21AE27012/2019 FAE27-087/2013 FAE27-012/2019 FGérard Claude4a 1m 14j5H1122-04-20195Tx11
22
23AE27-094/2012 MAE27-093/2012 MAE27-094/2012 MGérard Claude10a 11m 28j2B168-06-20124Tx2
24HTY0127 100/2012 FAE27-093/2012 MAE27-100/2012 FGérard Claude10a 11m 26j2B1310-06-20124T3
25
26AEY27 093/2012 MAET27-093/2022 MAE27-093/2012 MGérard Claude10a 11m 28j2B168-06-20124T1
Résultat
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"
Maybe I am not understanding your problem. The following VBA code inserts a new row when a value in column B changes.

I see that your code is sorting the data. Is that necessary?

Try this code:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim sheet As Worksheet
  Set sheet = Target.Parent
  If Target.Column = 2 Then  'If the value in Column B changed
    sheet.Rows(Target.Row + 1).Insert
  End If
End Sub
 
Upvote 0
If the code works for you add it to the Worksheet code for your data set.
 
Upvote 0
Try putting this as the first line of code immediately after the Sub line...

Application.ScreenUpdating = False

and this as the last line of code immediately before the End Sub...

Application.ScreenUpdating = True
 
Upvote 0
Hello Bosquedeguate.
Thank you for your reply.
It is true that the code works for a small table, I put it in my sheet named: "Result", I linked it to a button to execute it. So everything works as I want.
However, if I ask to optimize the code or modify it, it is to make it faster, since it is slow to run because the number of rows to be processed is important, hence my request for the use of tables.
Yes, it is necessary to sort the table to group together all the rows with the cells of the same value in column "B", thus, during the test, you can easily insert an empty row between each group that does not have the same cell in column "B" in common.
In the end, the code groups all the rows having the same cells in column "B" and separates them from the other groups which do not have different cells in column "B".
I hope I have explained myself well.
To read to you.


The table groups rows with the same cells into "B" columns :


Classeur2.xlsm
ABCDEFGHIJKL
1JeunePèreMèreEleveurAgeVolièreCageNé(e)ToursInformationElevageN° Ligne
2AE27013/2019 MAE27-013/2019 MAE27-013/2019 MGérard Claude4a 1m 14j4H122-04-20194Tx12
3
4AE27014/2019 FAE27-014/2019 FAE27-014/2019 FGérard Claude4a 1m 16j4H220-04-20194T13
5AE27015/2019 MAE27-014/2019 FAE27-015/2019 MGérard Claude4a 1m 17j4H619-04-20194Tx14
6
7AE27 017/2019 FAE27-017/2019 FAE27-017/2019 FGérard Claude4a 1m 17j3H619-04-20194T15
8
9AE27-042/2022 MAE27-042/2022 MAE27-042/2022 MGérard Claude0a 11m 18j5H618-06-20224Tx16
10AE27 043/2022 FAE27-042/2022 MAE27-043/2022 FGérard Claude0a 11m 18j4H618-06-20224Tx17
11
12AE27-059/2013 FAE27-059/2013 FAE27-059/2013 FGérard Claude10a 1m 11j3H1325-04-20134Tx4
13AE27060/2013 MAE27-059/2013 FAE27-060/2013 MGérard Claude10a 0m 31j5H195-05-20135T5
14
15AE27-084/2013 MAE27-084/2013 MAE27-084/2013 MGérard Claude10a 0m 17j3H1619-05-20134T6
16AE27085/2013 MAE27-084/2013 MAE27-085/2013 MGérard Claude10a 0m 18j5H2118-05-20134Tx7
17AE27 086/2013 FAE27-084/2013 MAE27-086/2013 FGérard Claude9a 11m 9j2B2127-06-20134T8
18
19AE27-087/2013 FAE27-087/2013 FAE27-087/2013 FGérard Claude10a 0m 18j5H2218-05-20134Tx9
20AE27011/2019 FAE27-087/2013 FAE27-011/2019 FGérard Claude4a 1m 14j4H1122-04-20195Tx10
21AE27012/2019 FAE27-087/2013 FAE27-012/2019 FGérard Claude4a 1m 14j5H1122-04-20195Tx11
22
23AE27-094/2012 MAE27-093/2012 MAE27-094/2012 MGérard Claude10a 11m 28j2B168-06-20124Tx2
24HTY0127 100/2012 FAE27-093/2012 MAE27-100/2012 FGérard Claude10a 11m 26j2B1310-06-20124T3
25
26AEY27 093/2012 MAET27-093/2022 MAE27-093/2012 MGérard Claude10a 11m 28j2B168-06-20124T1
Résultat
 
Upvote 0
Try putting this as the first line of code immediately after the Sub line...

Application.ScreenUpdating = False

and this as the last line of code immediately before the End Sub...

Application.ScreenUpdating = True
Thanks for the suggestion. If seen this in a number of examples. Code added.
 
Upvote 0
Your code looks very efficient.

You could try different sorting algorithms: insert sort, merge sort, bubble sort, .... to see if one is faster than another. It's been too many years since I have visited that topic.
This would mean you would have to write code for the different algorithms. (Probably not worth the effort).

How many records do you have in your table?

Sorry I can't be very helpful on this one!!
 
Upvote 0
Hello Bosquedeguate & Rick Rothstein.
Thank you for your response and the suggestion.
Yes it's true, we save a lot of time, the code is faster.
Thanks to you two.
 
Upvote 0
If your data is large, this should be a bit faster. It checks for the change in value in memory rather that going to the worksheet to check each line.

VBA Code:
Sub Insert_Rows_v2()
  Dim a As Variant
  Dim x As Long
 
  Application.ScreenUpdating = False
  With Range("A2:L" & Range("B" & Rows.Count).End(xlUp).Row)
    .Sort key1:=Range("B2"), order1:=xlAscending, Header:=xlNo
    a = .Columns(2).Value
    For x = UBound(a) To 2 Step -1
      If a(x, 1) <> a(x - 1, 1) Then .Rows(x).EntireRow.Insert
    Next x
  End With
  Application.ScreenUpdating = True
End Sub
 
Last edited:
Upvote 0
Solution
Hello Peter_SSs,
Thank you for your suggestion, that's what I wanted.
I completely agree with you, using arrays (UBound) is faster than the code I had at my disposal.
Thank you so much.
Cheers.
 
Upvote 0

Forum statistics

Threads
1,223,895
Messages
6,175,257
Members
452,625
Latest member
saadat28

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top