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

Cybermiser

New Member
Joined
Sep 15, 2016
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
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!
 

Attachments

  • Insert Rows and Transpose.jpg
    Insert Rows and Transpose.jpg
    120.8 KB · Views: 9

Some videos you may like

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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

New Member
Joined
Sep 15, 2016
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
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
ABCDEFGHIJKLMNOP
11Final Output:
24214242LeggElizabeth701780FemaleVirginia
34224242LenardJohn341816MaleNew York
4Legg34343DuttonSamuel351815MaleFarmerAgriculture300Ohio
5Elizabeth44343DuttonM361814FemaleOhio
67054444PuckettN291821MaleFarmerAgriculture100OhioY
7178064444PuckettE241826FemaleOhioY
8Female74545SetterfieldJames411809MaleFarmerAgriculture250Ohio
9Virginia84545SetterfieldMahala401810FemaleVirginia
10294545SetterfieldC191831MaleFarmerAgricultureOhio
1142104545SetterfieldF161834FemaleOhioY
1242114545SetterfieldT141836MaleOhio
13Lenard124545SetterfieldN121838MaleOhio
14John134545SetterfieldL101840MaleOhio
1534
161816
17Male
18New York
193
2043
2143
22Dutton
23Samuel
2435
251815
26Male
27Farmer
28Agriculture
29300
30Ohio
314
3243
3343
34Dutton
35M
3636
371814
38Female
39Ohio
405
4144
4244
43Puckett
44N
4529
461821
47Male
48Farmer
49Agriculture
50100
51Ohio
52Y
536
5444
5544
56Puckett
57E
5824
591826
60Female
61Ohio
62Y
637
6445
6545
66Setterfield
67James
6841
691809
70Male
71Farmer
72Agriculture
73250
74Ohio
758
7645
7745
78Setterfield
79Mahala
8040
811810
82Female
83Virginia
849
8545
8645
87Setterfield
88C
8919
901831
91Male
92Farmer
93Agriculture
94Ohio
9510
9645
9745
98Setterfield
99F
10016
1011834
102Female
103Ohio
104Y
10511
10645
10745
108Setterfield
109T
11014
1111836
112Male
113Ohio
11412
11545
11645
117Setterfield
118N
11912
1201838
121Male
122Ohio
12313
12445
12545
126Setterfield
127L
12810
1291840
130Male
131Ohio
Starting Data
 

Cybermiser

New Member
Joined
Sep 15, 2016
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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

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.

VBA Code:
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
ABCDEFGHIJKLMNOP
1114242LeggElizabeth701780FemaleVirginia
24224242LenardJohn341816MaleNew York
34234343DuttonSamuel351815MaleFarmerAgriculture300Ohio
4Legg44343DuttonM361814FemaleOhio
5Elizabeth54444PuckettN291821MaleFarmerAgriculture100OhioY
67064444PuckettE241826FemaleOhioY
7178074545SetterfieldJames411809MaleFarmerAgriculture250Ohio
8Female84545SetterfieldMahala401810FemaleVirginia
9Virginia94545SetterfieldC191831MaleFarmerAgricultureOhio
102104545SetterfieldF161834FemaleOhioY
1142114545SetterfieldT141836MaleOhio
1242124545SetterfieldN121838MaleOhio
13Lenard134545SetterfieldL101840MaleOhio
14John
1534
161816
17Male
18New York
193
2043
2143
22Dutton
23Samuel
2435
251815
26Male
27Farmer
28Agriculture
29300
30Ohio
314
3243
3343
34Dutton
35M
3636
371814
38Female
39Ohio
405
4144
4244
43Puckett
44N
4529
461821
47Male
48Farmer
49Agriculture
50100
51Ohio
52Y
536
5444
5544
56Puckett
57E
5824
591826
60Female
61Ohio
62Y
637
6445
6545
66Setterfield
67James
6841
691809
70Male
71Farmer
72Agriculture
73250
74Ohio
758
7645
7745
78Setterfield
79Mahala
8040
811810
82Female
83Virginia
849
8545
8645
87Setterfield
88C
8919
901831
91Male
92Farmer
93Agriculture
94Ohio
9510
9645
9745
98Setterfield
99F
10016
1011834
102Female
103Ohio
104Y
10511
10645
10745
108Setterfield
109T
11014
1111836
112Male
113Ohio
11412
11545
11645
117Setterfield
118N
11912
1201838
121Male
122Ohio
12313
12445
12545
126Setterfield
127L
12810
1291840
130Male
131Ohio
132
Sheet1
 
Last edited:
Solution

Cybermiser

New Member
Joined
Sep 15, 2016
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
OK, thanks for the 'copyable' sample data, makes helping much easier. (y)

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.

VBA Code:
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
ABCDEFGHIJKLMNOP
1114242LeggElizabeth701780FemaleVirginia
24224242LenardJohn341816MaleNew York
34234343DuttonSamuel351815MaleFarmerAgriculture300Ohio
4Legg44343DuttonM361814FemaleOhio
5Elizabeth54444PuckettN291821MaleFarmerAgriculture100OhioY
67064444PuckettE241826FemaleOhioY
7178074545SetterfieldJames411809MaleFarmerAgriculture250Ohio
8Female84545SetterfieldMahala401810FemaleVirginia
9Virginia94545SetterfieldC191831MaleFarmerAgricultureOhio
102104545SetterfieldF161834FemaleOhioY
1142114545SetterfieldT141836MaleOhio
1242124545SetterfieldN121838MaleOhio
13Lenard134545SetterfieldL101840MaleOhio
14John
1534
161816
17Male
18New York
193
2043
2143
22Dutton
23Samuel
2435
251815
26Male
27Farmer
28Agriculture
29300
30Ohio
314
3243
3343
34Dutton
35M
3636
371814
38Female
39Ohio
405
4144
4244
43Puckett
44N
4529
461821
47Male
48Farmer
49Agriculture
50100
51Ohio
52Y
536
5444
5544
56Puckett
57E
5824
591826
60Female
61Ohio
62Y
637
6445
6545
66Setterfield
67James
6841
691809
70Male
71Farmer
72Agriculture
73250
74Ohio
758
7645
7745
78Setterfield
79Mahala
8040
811810
82Female
83Virginia
849
8545
8645
87Setterfield
88C
8919
901831
91Male
92Farmer
93Agriculture
94Ohio
9510
9645
9745
98Setterfield
99F
10016
1011834
102Female
103Ohio
104Y
10511
10645
10745
108Setterfield
109T
11014
1111836
112Male
113Ohio
11412
11545
11645
117Setterfield
118N
11912
1201838
121Male
122Ohio
12313
12445
12545
126Setterfield
127L
12810
1291840
130Male
131Ohio
132
Sheet1
Thank you! This is exactly what I was looking for! I appreciate the speedy response!
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

Thank you! This is exactly what I was looking for! I appreciate the speedy response!
You're welcome. Thanks for the follow-up. :)
 

Cybermiser

New Member
Joined
Sep 15, 2016
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
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
11
21117
31086
4Thurman
5Joel
642
71819
8Male
9Farmer
107500
111200
12Ohio
132
141117
151086
16Thurman
17Rachel
1830
191830
20Female
21Ohio
223
231117
241086
25Thurman
26John M
2717
281843
29Male
30Illinois
31Yes
324
331117
341086
35Thurman
36Thomas
3719
381841
39Male
40Illinois
41Yes
425
431117
441086
45Thurman
46William S
4712
481848
49Male
50Illinois
51Yes
526
531117
541086
55Thurman
56Henisa
577
581853
59Female
60Illinois
61Yes
627
631117
641086
65Thurman
66Nelson
675
681855
69Male
70Illinois
718
721117
731086
74Botts
75Ann
7617
771843
78Female
79Illinois
80Yes
819
821117
831086
84Goerge
85Alexander
8620
871840
88Male
89Illinois
90Yes
9110
921117
931086
94Evelsizer
95Anias A
961
971859
98Male
99Illinois
10011
1011118
1021087
103Coler
104Simon
10524
1061836
107Male
108Laborer
109New York
11012
1111118
1121087
113Coler
114Arilda
11521
1161839
117Female
118New York
11913
1201118
1211087
Sheet3
 

Cybermiser

New Member
Joined
Sep 15, 2016
Messages
10
Office Version
  1. 2016
Platform
  1. Windows
Peter, In all instances, there are three consecutive numbers, if that helps at all...
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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

Rich (BB 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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,252
Messages
5,600,543
Members
414,387
Latest member
Vincent88

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
Top