I need a VBA to count groups of 4 rows and insert a row if there are less than 4 rows to the group

[agarci1096]

Hi, I have a data set that has rows numbered groups of 4 rows counting up from 0 to 100. It will then start over at 0 and count up to 100 again, and repeat this several thousand times.
Like this:
Column H ---- Column I
0
0
0
0
1
1
1
1

However some groups will only have 2 or 3 rows and it needs to be 4
Like this:
Column H ---- Column I
2
2
3
3
3

I'm fairly new at macros and am pretty lost on this whole thing. I need a VBA that will insert a row with the number of the group if there are less than 4 rows to a group. Any help on where to start with this would be greatly appreciated!

 

[jolivanes]

Hi Peter.
It was not meant to say who is right or who is wrong or which is fast and which is slow. Just an observation. Anyway, the macros were both used on the same data structure.
I also used the insert entire rows as well as resize 8 columns in the code i have and it made very little difference.
A few seconds here and there while you sit at home being a good citizen with this Covid problem should not break the bank.
All of this becomes moot because of your latest code. You're cooking with gas there.

 

[Peter_SSs]

A few seconds here and there while you sit at home being a good citizen with this Covid problem should not break the bank.

 

[agarci1096]

I'm not suggesting that my code is right or yours is wrong but I do note that the codes are doing different things, so it isn't too surprising that the times are different. If you test with some data in other columns (which I assume there is since this number data is in column H) you will see.



Not certain what you mean by this as earlier you said ..

So, I am assuming that you mean to leave all the other columns empty, not filling them with the above data like my previous code did. If so, you could try this code.
For me, with 200,000 rows to start, ending with 510,000 rows the code took about 2.6 seconds.

Sub Insert_Rows_v2()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, nc As Long, nr As Long, lr As Long

  lr = Range("H" & Rows.Count).End(xlUp).Row
  a = Range("H1:H" & lr + 3).Value
  i = 2
  nc = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
  ReDim b(1 To Rows.Count, 1 To 1)
  b(1, 1) = 1
  nr = lr
  Do
    b(i, 1) = i
    For j = 1 To 3
      If a(i + j, 1) <> a(i, 1) Or i + j > UBound(a) Then
        For k = 0 To j - 1
          b(i + k, 1) = i
        Next k
        For k = 1 To 4 - j
          b(nr + k, 1) = i
        Next k
        nr = nr + 4 - j
        Exit For
      Else
        b(i + j, 1) = i
      End If
    Next j
    i = i + j
  Loop Until i > lr
  If nr > lr Then
    Application.ScreenUpdating = False
      With Range("A1").Resize(nr, nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlYes
        a = .Columns("H").Value
        For i = 2 To nr Step 4
          For j = 1 To 3
            a(i + j, 1) = a(i, 1)
          Next j
        Next i
        .Columns("H").Value = a
        .Columns(nc).ClearContents
      End With
    Application.ScreenUpdating = True
  End If
End Sub

Here is a small sample.
Before:

agarci.xlsm
	A	B	C	D	E	F	G	H	I
1	Hdr 1	Hdr 2	Hdr 3	Hdr 4	Hdr 5	Hdr 6	Hdr 7	Hdr 8	Hdr 9
2	A2	B2	C2	D2	E2	F2	G2	1	I2
3	A3	B3	C3	D3	E3	F3	G3	1	I3
4	A4	B4	C4	D4	E4	F4	G4	3	I4
5	A5	B5	C5	D5	E5	F5	G5	5	I5
6	A6	B6	C6	D6	E6	F6	G6	5	I6
7	A7	B7	C7	D7	E7	F7	G7	5	I7
8	A8	B8	C8	D8	E8	F8	G8	5	I8
9	A9	B9	C9	D9	E9	F9	G9	8	I9
10	A10	B10	C10	D10	E10	F10	G10	8	I10
11	A11	B11	C11	D11	E11	F11	G11	10	I11
12	A12	B12	C12	D12	E12	F12	G12	10	I12
13	A13	B13	C13	D13	E13	F13	G13	10	I13
14	A14	B14	C14	D14	E14	F14	G14	10	I14
15
Sample

After:

agarci.xlsm
	A	B	C	D	E	F	G	H	I
1	Hdr 1	Hdr 2	Hdr 3	Hdr 4	Hdr 5	Hdr 6	Hdr 7	Hdr 8	Hdr 9
2	A2	B2	C2	D2	E2	F2	G2	1	I2
3	A3	B3	C3	D3	E3	F3	G3	1	I3
4								1
5								1
6	A4	B4	C4	D4	E4	F4	G4	3	I4
7								3
8								3
9								3
10	A5	B5	C5	D5	E5	F5	G5	5	I5
11	A6	B6	C6	D6	E6	F6	G6	5	I6
12	A7	B7	C7	D7	E7	F7	G7	5	I7
13	A8	B8	C8	D8	E8	F8	G8	5	I8
14	A9	B9	C9	D9	E9	F9	G9	8	I9
15	A10	B10	C10	D10	E10	F10	G10	8	I10
16								8
17								8
18	A11	B11	C11	D11	E11	F11	G11	10	I11
19	A12	B12	C12	D12	E12	F12	G12	10	I12
20	A13	B13	C13	D13	E13	F13	G13	10	I13
21	A14	B14	C14	D14	E14	F14	G14	10	I14
22
Sample

Hi, sorry I replied pretty late, but thanks so much for your help. v2 worked perfect.

 

[Peter_SSs]

Glad it worked for you. Thanks for the follow-up,