VBA Code to Insert Variable # of Rows to be Added Below Data So All data sets have Same Number of Rows

[Cybermiser]

Hello,
I'm new to VBA but would like to see if anyone could help me with my VBA code. Attached is a screenshot of the expected result.

Process: I copied column from an online index which has variable number of rows per individual.
In order to transpose the data and align data properly, each set of data "Record" must have the same number of rows.

Rows assigned to a record could range from 8 to 13
Individuals could be alone or part of a family.

Example:
Record #1 - rows 1-9 (9 rows) (that I'll call "Q" through "Z")
Group #42

Record #2 - rows 10-18 (9 rows) (that I'll call "Q2" through "Z2")
Group #42

Record #3 - rows 19-30 (12 rows) (that I'll call "Q3" through "Z3")
Group #43
...etc
If I look at it, I can see that there's a value assigned to each individual, however as well as a "group number" that immediately follows. (ie 1, 42; 2, 42; 3, 43 etc) So that's what I think could be used to determine how many rows to insert.
Data is manually pasted into Column A - no other data present on spreadsheet or workbook.

VBA Code Steps:
Remove the word Close in the last cell
Assign incremental value to each row starting in B1 (assuming that I have to take this step before we can determine how many rows to insert)
Count the number of rows per individual starting with 1 (Originating Cell that I'll call "Q")
If subsequent cell increments by 1 AND the value after it either is the same or increments by one then (Q + 1 (ie "Z"):

Count number of cells between and including Q and Z.

If count = 10 then insert three rows after Z
If count = 9 > insert 4 rows after Z
If count = 13 then go to next set of data

Repeat with next set starting with "Q2"

Thanks for any help!

 

[Peter_SSs]

Could you give us a set of sample dummy data that included, say 4 people in the original format that showed the variety of information and rows that we might get.
Can you give us that data with XL2BB as most helpers will not want to manually type out that much data to test with.

I also suggest that you update your Account details (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’)

 

[Cybermiser]

Hello,
I'm new to VBA but would like to see if anyone could help me with my VBA code. Attached is a screenshot of the expected result.

Process: I copied column from an online index which has variable number of rows per individual.
In order to transpose the data and align data properly, each set of data "Record" must have the same number of rows.

Rows assigned to a record could range from 8 to 13
Individuals could be alone or part of a family.

Example:
Record #1 - rows 1-9 (9 rows) (that I'll call "Q" through "Z")
Group #42

Record #2 - rows 10-18 (9 rows) (that I'll call "Q2" through "Z2")
Group #42

Record #3 - rows 19-30 (12 rows) (that I'll call "Q3" through "Z3")
Group #43
...etc
If I look at it, I can see that there's a value assigned to each individual, however as well as a "group number" that immediately follows. (ie 1, 42; 2, 42; 3, 43 etc) So that's what I think could be used to determine how many rows to insert.
Data is manually pasted into Column A - no other data present on spreadsheet or workbook.

VBA Code Steps:
Remove the word Close in the last cell
Assign incremental value to each row starting in B1 (assuming that I have to take this step before we can determine how many rows to insert)
Count the number of rows per individual starting with 1 (Originating Cell that I'll call "Q")
If subsequent cell increments by 1 AND the value after it either is the same or increments by one then (Q + 1 (ie "Z"):

Count number of cells between and including Q and Z.

If count = 10 then insert three rows after Z
If count = 9 > insert 4 rows after Z
If count = 13 then go to next set of data

Repeat with next set starting with "Q2"

Thanks for any help!

Here's an example of the data in column A and the final output in columns D-P.

Sample Data.xlsx
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	1			Final Output:
2	42			1	42	42	Legg	Elizabeth	70	1780	Female	Virginia
3	42			2	42	42	Lenard	John	34	1816	Male	New York
4	Legg			3	43	43	Dutton	Samuel	35	1815	Male	Farmer	Agriculture	300	Ohio
5	Elizabeth			4	43	43	Dutton	M	36	1814	Female	Ohio
6	70			5	44	44	Puckett	N	29	1821	Male	Farmer	Agriculture	100	Ohio	Y
7	1780			6	44	44	Puckett	E	24	1826	Female	Ohio	Y
8	Female			7	45	45	Setterfield	James	41	1809	Male	Farmer	Agriculture	250	Ohio
9	Virginia			8	45	45	Setterfield	Mahala	40	1810	Female	Virginia
10	2			9	45	45	Setterfield	C	19	1831	Male	Farmer	Agriculture	Ohio
11	42			10	45	45	Setterfield	F	16	1834	Female	Ohio	Y
12	42			11	45	45	Setterfield	T	14	1836	Male	Ohio
13	Lenard			12	45	45	Setterfield	N	12	1838	Male	Ohio
14	John			13	45	45	Setterfield	L	10	1840	Male	Ohio
15	34
16	1816
17	Male
18	New York
19	3
20	43
21	43
22	Dutton
23	Samuel
24	35
25	1815
26	Male
27	Farmer
28	Agriculture
29	300
30	Ohio
31	4
32	43
33	43
34	Dutton
35	M
36	36
37	1814
38	Female
39	Ohio
40	5
41	44
42	44
43	Puckett
44	N
45	29
46	1821
47	Male
48	Farmer
49	Agriculture
50	100
51	Ohio
52	Y
53	6
54	44
55	44
56	Puckett
57	E
58	24
59	1826
60	Female
61	Ohio
62	Y
63	7
64	45
65	45
66	Setterfield
67	James
68	41
69	1809
70	Male
71	Farmer
72	Agriculture
73	250
74	Ohio
75	8
76	45
77	45
78	Setterfield
79	Mahala
80	40
81	1810
82	Female
83	Virginia
84	9
85	45
86	45
87	Setterfield
88	C
89	19
90	1831
91	Male
92	Farmer
93	Agriculture
94	Ohio
95	10
96	45
97	45
98	Setterfield
99	F
100	16
101	1834
102	Female
103	Ohio
104	Y
105	11
106	45
107	45
108	Setterfield
109	T
110	14
111	1836
112	Male
113	Ohio
114	12
115	45
116	45
117	Setterfield
118	N
119	12
120	1838
121	Male
122	Ohio
123	13
124	45
125	45
126	Setterfield
127	L
128	10
129	1840
130	Male
131	Ohio
Starting Data

 

[Cybermiser]

Could you give us a set of sample dummy data that included, say 4 people in the original format that showed the variety of information and rows that we might get.
Can you give us that data with XL2BB as most helpers will not want to manually type out that much data to test with.

I also suggest that you update your Account details (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’)

All done! Thanks! That's really a slick Add-in!

 

[Peter_SSs]

OK, thanks for the 'copyable' sample data, makes helping much easier.

This data does not have 'Close' at the end so the code may need slight adjustment if that is in fact there.
Try this with a copy of your workbook.

The 'pattern' that I used was that each block starts where there are 3 consecutive numerical values and the second two of them are equal. If that is not the case throughout your data we will have to look again.

Sub Rearrange()
  Dim a As Variant
  Dim j As Long, k As Long, fr As Long
  
  a = Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(3)).Value
  fr = 1
  j = 3
  k = 1
  Application.ScreenUpdating = False
  Do
    If IsNumeric(a(fr + j - 1, 1) & a(fr + j, 1) & a(fr + j + 1, 1) & 0) And a(fr + j, 1) = a(fr + j + 1, 1) Then
      Range("D" & k).Resize(, j - 1).Value = Application.Transpose(Range("A" & fr).Resize(j - 1).Value)
      fr = fr + j - 1
      j = 3
      k = k + 1
    Else
      j = j + 1
    End If
  Loop Until fr + j >= UBound(a)
  Application.ScreenUpdating = True
End Sub

My sample data and results of this code:

Cybermiser.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	1			1	42	42	Legg	Elizabeth	70	1780	Female	Virginia
2	42			2	42	42	Lenard	John	34	1816	Male	New York
3	42			3	43	43	Dutton	Samuel	35	1815	Male	Farmer	Agriculture	300	Ohio
4	Legg			4	43	43	Dutton	M	36	1814	Female	Ohio
5	Elizabeth			5	44	44	Puckett	N	29	1821	Male	Farmer	Agriculture	100	Ohio	Y
6	70			6	44	44	Puckett	E	24	1826	Female	Ohio	Y
7	1780			7	45	45	Setterfield	James	41	1809	Male	Farmer	Agriculture	250	Ohio
8	Female			8	45	45	Setterfield	Mahala	40	1810	Female	Virginia
9	Virginia			9	45	45	Setterfield	C	19	1831	Male	Farmer	Agriculture	Ohio
10	2			10	45	45	Setterfield	F	16	1834	Female	Ohio	Y
11	42			11	45	45	Setterfield	T	14	1836	Male	Ohio
12	42			12	45	45	Setterfield	N	12	1838	Male	Ohio
13	Lenard			13	45	45	Setterfield	L	10	1840	Male	Ohio
14	John
15	34
16	1816
17	Male
18	New York
19	3
20	43
21	43
22	Dutton
23	Samuel
24	35
25	1815
26	Male
27	Farmer
28	Agriculture
29	300
30	Ohio
31	4
32	43
33	43
34	Dutton
35	M
36	36
37	1814
38	Female
39	Ohio
40	5
41	44
42	44
43	Puckett
44	N
45	29
46	1821
47	Male
48	Farmer
49	Agriculture
50	100
51	Ohio
52	Y
53	6
54	44
55	44
56	Puckett
57	E
58	24
59	1826
60	Female
61	Ohio
62	Y
63	7
64	45
65	45
66	Setterfield
67	James
68	41
69	1809
70	Male
71	Farmer
72	Agriculture
73	250
74	Ohio
75	8
76	45
77	45
78	Setterfield
79	Mahala
80	40
81	1810
82	Female
83	Virginia
84	9
85	45
86	45
87	Setterfield
88	C
89	19
90	1831
91	Male
92	Farmer
93	Agriculture
94	Ohio
95	10
96	45
97	45
98	Setterfield
99	F
100	16
101	1834
102	Female
103	Ohio
104	Y
105	11
106	45
107	45
108	Setterfield
109	T
110	14
111	1836
112	Male
113	Ohio
114	12
115	45
116	45
117	Setterfield
118	N
119	12
120	1838
121	Male
122	Ohio
123	13
124	45
125	45
126	Setterfield
127	L
128	10
129	1840
130	Male
131	Ohio
132
Sheet1

 

[Cybermiser]

OK, thanks for the 'copyable' sample data, makes helping much easier.

This data does not have 'Close' at the end so the code may need slight adjustment if that is in fact there.
Try this with a copy of your workbook.

The 'pattern' that I used was that each block starts where there are 3 consecutive numerical values and the second two of them are equal. If that is not the case throughout your data we will have to look again.

Sub Rearrange()
  Dim a As Variant
  Dim j As Long, k As Long, fr As Long
 
  a = Range("A1", Range("A" & Rows.Count).End(xlUp).Offset(3)).Value
  fr = 1
  j = 3
  k = 1
  Application.ScreenUpdating = False
  Do
    If IsNumeric(a(fr + j - 1, 1) & a(fr + j, 1) & a(fr + j + 1, 1) & 0) And a(fr + j, 1) = a(fr + j + 1, 1) Then
      Range("D" & k).Resize(, j - 1).Value = Application.Transpose(Range("A" & fr).Resize(j - 1).Value)
      fr = fr + j - 1
      j = 3
      k = k + 1
    Else
      j = j + 1
    End If
  Loop Until fr + j >= UBound(a)
  Application.ScreenUpdating = True
End Sub

My sample data and results of this code:

Cybermiser.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P
1	1			1	42	42	Legg	Elizabeth	70	1780	Female	Virginia
2	42			2	42	42	Lenard	John	34	1816	Male	New York
3	42			3	43	43	Dutton	Samuel	35	1815	Male	Farmer	Agriculture	300	Ohio
4	Legg			4	43	43	Dutton	M	36	1814	Female	Ohio
5	Elizabeth			5	44	44	Puckett	N	29	1821	Male	Farmer	Agriculture	100	Ohio	Y
6	70			6	44	44	Puckett	E	24	1826	Female	Ohio	Y
7	1780			7	45	45	Setterfield	James	41	1809	Male	Farmer	Agriculture	250	Ohio
8	Female			8	45	45	Setterfield	Mahala	40	1810	Female	Virginia
9	Virginia			9	45	45	Setterfield	C	19	1831	Male	Farmer	Agriculture	Ohio
10	2			10	45	45	Setterfield	F	16	1834	Female	Ohio	Y
11	42			11	45	45	Setterfield	T	14	1836	Male	Ohio
12	42			12	45	45	Setterfield	N	12	1838	Male	Ohio
13	Lenard			13	45	45	Setterfield	L	10	1840	Male	Ohio
14	John
15	34
16	1816
17	Male
18	New York
19	3
20	43
21	43
22	Dutton
23	Samuel
24	35
25	1815
26	Male
27	Farmer
28	Agriculture
29	300
30	Ohio
31	4
32	43
33	43
34	Dutton
35	M
36	36
37	1814
38	Female
39	Ohio
40	5
41	44
42	44
43	Puckett
44	N
45	29
46	1821
47	Male
48	Farmer
49	Agriculture
50	100
51	Ohio
52	Y
53	6
54	44
55	44
56	Puckett
57	E
58	24
59	1826
60	Female
61	Ohio
62	Y
63	7
64	45
65	45
66	Setterfield
67	James
68	41
69	1809
70	Male
71	Farmer
72	Agriculture
73	250
74	Ohio
75	8
76	45
77	45
78	Setterfield
79	Mahala
80	40
81	1810
82	Female
83	Virginia
84	9
85	45
86	45
87	Setterfield
88	C
89	19
90	1831
91	Male
92	Farmer
93	Agriculture
94	Ohio
95	10
96	45
97	45
98	Setterfield
99	F
100	16
101	1834
102	Female
103	Ohio
104	Y
105	11
106	45
107	45
108	Setterfield
109	T
110	14
111	1836
112	Male
113	Ohio
114	12
115	45
116	45
117	Setterfield
118	N
119	12
120	1838
121	Male
122	Ohio
123	13
124	45
125	45
126	Setterfield
127	L
128	10
129	1840
130	Male
131	Ohio
132
Sheet1

Thank you! This is exactly what I was looking for! I appreciate the speedy response!

 

[Peter_SSs]

Thank you! This is exactly what I was looking for! I appreciate the speedy response!

You're welcome. Thanks for the follow-up.

 

[Cybermiser]

Thank you! This is exactly what I was looking for! I appreciate the speedy response!

You're welcome. Thanks for the follow-up.

Hi Peter, I came across an issue where the 2nd and 3rd numbers are not equal.
Can you help get the macro to account for that as well?

Ohio Research.xlsm
	A
1	1
2	1117
3	1086
4	Thurman
5	Joel
6	42
7	1819
8	Male
9	Farmer
10	7500
11	1200
12	Ohio
13	2
14	1117
15	1086
16	Thurman
17	Rachel
18	30
19	1830
20	Female
21	Ohio
22	3
23	1117
24	1086
25	Thurman
26	John M
27	17
28	1843
29	Male
30	Illinois
31	Yes
32	4
33	1117
34	1086
35	Thurman
36	Thomas
37	19
38	1841
39	Male
40	Illinois
41	Yes
42	5
43	1117
44	1086
45	Thurman
46	William S
47	12
48	1848
49	Male
50	Illinois
51	Yes
52	6
53	1117
54	1086
55	Thurman
56	Henisa
57	7
58	1853
59	Female
60	Illinois
61	Yes
62	7
63	1117
64	1086
65	Thurman
66	Nelson
67	5
68	1855
69	Male
70	Illinois
71	8
72	1117
73	1086
74	Botts
75	Ann
76	17
77	1843
78	Female
79	Illinois
80	Yes
81	9
82	1117
83	1086
84	Goerge
85	Alexander
86	20
87	1840
88	Male
89	Illinois
90	Yes
91	10
92	1117
93	1086
94	Evelsizer
95	Anias A
96	1
97	1859
98	Male
99	Illinois
100	11
101	1118
102	1087
103	Coler
104	Simon
105	24
106	1836
107	Male
108	Laborer
109	New York
110	12
111	1118
112	1087
113	Coler
114	Arilda
115	21
116	1839
117	Female
118	New York
119	13
120	1118
121	1087
Sheet3

 

[Cybermiser]

Peter, In all instances, there are three consecutive numbers, if that helps at all...

 

[Peter_SSs]

OK, assuming that 3 numbers in consecutive cells happens at the start of every record and never in the middle or at the end of a record then the change is easy - just remove this code

If IsNumeric(a(fr + j - 1, 1) & a(fr + j, 1) & a(fr + j + 1, 1) & 0) And a(fr + j, 1) = a(fr + j + 1, 1) Then