Insert row under each criteria

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows
My data starts from Column A2 to J1002

So column C has the criteria say "x", "y", "z", etc.

These criteria are sorted so they are grouped.

That's all x all y all z in that order.

So I want to insert a blank row after the last x, then a blank row under the last y in that order.

Row 1 is the header

I am looking for a vba solution to this.

Thanks in advance
 

Some videos you may like

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
Try this:

Code:
Sub a1090658a()
Dim i As Long
For i = 1002 To 2 Step -1
    Do While Cells(i, "C") = Cells(i - 1, "C")
        i = i - 1
    Loop
    If i = 2 Then Exit For
    Rows(i).Insert xlUp
Next
End Sub
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows
Unbelievable! !!

Very brilliant.


One last thing :

From column D to J are values that needs to be added.

And they are supposed to be placed inside those blank rows.

That's all x added all y added etc.

I am sure this is possible as well.

Thanks
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
Do you mean value of col C will be copied to col D:J on the blank row?
Say there are only 3 "x" in col C, so col D:J will have "x" or only col D:F?
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

Do you mean value of col C will be copied to col D:J on the blank row?
Say there are only 3 "x" in col C, so col D:J will have "x" or only col D:F?


I am adding all the column D values for "x" and place it inside that empty cell under the "x". Then I do same for E, F, ...J.

Then with criteria "y" , we do same as above. In that order.

That's finding Sub totals .
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
Ok, try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1090658b()
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] q [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] r [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] va

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1002[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Step[/COLOR] -[COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Do[/COLOR] [COLOR=Royalblue]While[/COLOR] Cells(i, [COLOR=brown]"C"[/COLOR]) = Cells(i - [COLOR=crimson]1[/COLOR], [COLOR=brown]"C"[/COLOR])
        i = i - [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Loop[/COLOR]
    [COLOR=Royalblue]If[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
    Rows(i).Insert xlUp
[COLOR=Royalblue]Next[/COLOR]

n = Range([COLOR=brown]"C"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
q = [COLOR=crimson]2[/COLOR]

[COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] r [COLOR=Royalblue]In[/COLOR] Range([COLOR=brown]"C2:C"[/COLOR] & n + [COLOR=crimson]1[/COLOR]).SpecialCells(xlCellTypeBlanks)
    [COLOR=Royalblue]For[/COLOR] k = [COLOR=crimson]4[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]10[/COLOR]
        x = r.Row
        Cells(x, k) = WorksheetFunction.Sum(Range(Cells(q, k), Cells(x - [COLOR=crimson]1[/COLOR], k)))
    [COLOR=Royalblue]Next[/COLOR]
    q = x + [COLOR=crimson]1[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

More than expected! !!

Thanks for the time and effort spent.
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
You're welcome, glad to help, & thanks for the feedback.:)
 

kelly mort

Well-known Member
Joined
Apr 10, 2017
Messages
1,796
Office Version
  1. 2016
Platform
  1. Windows
Ok, try this:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1090658b()
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] q [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] r [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] va

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1002[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Step[/COLOR] -[COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Do[/COLOR] [COLOR=Royalblue]While[/COLOR] Cells(i, [COLOR=brown]"C"[/COLOR]) = Cells(i - [COLOR=crimson]1[/COLOR], [COLOR=brown]"C"[/COLOR])
        i = i - [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Loop[/COLOR]
    [COLOR=Royalblue]If[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
    Rows(i).Insert xlUp
[COLOR=Royalblue]Next[/COLOR]

n = Range([COLOR=brown]"C"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
q = [COLOR=crimson]2[/COLOR]

[COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] r [COLOR=Royalblue]In[/COLOR] Range([COLOR=brown]"C2:C"[/COLOR] & n + [COLOR=crimson]1[/COLOR]).SpecialCells(xlCellTypeBlanks)
    [COLOR=Royalblue]For[/COLOR] k = [COLOR=crimson]4[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]10[/COLOR]
        x = r.Row
        Cells(x, k) = WorksheetFunction.Sum(Range(Cells(q, k), Cells(x - [COLOR=crimson]1[/COLOR], k)))
    [COLOR=Royalblue]Next[/COLOR]
    q = x + [COLOR=crimson]1[/COLOR]
[COLOR=Royalblue]Next[/COLOR]

Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]


Hello
Is there a way to add all the "sub total" into a cell say H2?

That's we add all those values in the sub total calculations we did into cell H2.

Regards


Kelly
 

Akuini

Well-known Member
Joined
Feb 1, 2016
Messages
2,575
Office Version
  1. 365
Platform
  1. Windows
Ok, this is untested:

Code:
[FONT=lucida console][COLOR=Royalblue]Sub[/COLOR] a1090658b()
[COLOR=Royalblue]Dim[/COLOR] i [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], j [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], k [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], n [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] q [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], x [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR], z [COLOR=Royalblue]As[/COLOR] [COLOR=Royalblue]Long[/COLOR]
[COLOR=Royalblue]Dim[/COLOR] r [COLOR=Royalblue]As[/COLOR] Range
[COLOR=Royalblue]Dim[/COLOR] va

Application.ScreenUpdating = [COLOR=Royalblue]False[/COLOR]
[COLOR=Royalblue]For[/COLOR] i = [COLOR=crimson]1002[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Step[/COLOR] -[COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Do[/COLOR] [COLOR=Royalblue]While[/COLOR] Cells(i, [COLOR=brown]"C"[/COLOR]) = Cells(i - [COLOR=crimson]1[/COLOR], [COLOR=brown]"C"[/COLOR])
        i = i - [COLOR=crimson]1[/COLOR]
    [COLOR=Royalblue]Loop[/COLOR]
    [COLOR=Royalblue]If[/COLOR] i = [COLOR=crimson]2[/COLOR] [COLOR=Royalblue]Then[/COLOR] [COLOR=Royalblue]Exit[/COLOR] [COLOR=Royalblue]For[/COLOR]
    Rows(i).Insert xlUp
[COLOR=Royalblue]Next[/COLOR]

n = Range([COLOR=brown]"C"[/COLOR] & Rows.count).[COLOR=Royalblue]End[/COLOR](xlUp).Row
q = [COLOR=crimson]2[/COLOR]

[COLOR=Royalblue]For[/COLOR] [COLOR=Royalblue]Each[/COLOR] r [COLOR=Royalblue]In[/COLOR] Range([COLOR=brown]"C2:C"[/COLOR] & n + [COLOR=crimson]1[/COLOR]).SpecialCells(xlCellTypeBlanks)
    [COLOR=Royalblue]For[/COLOR] k = [COLOR=crimson]4[/COLOR] [COLOR=Royalblue]To[/COLOR] [COLOR=crimson]10[/COLOR]
        x = r.Row
        Cells(x, k) = WorksheetFunction.Sum(Range(Cells(q, k), Cells(x - [COLOR=crimson]1[/COLOR], k)))
        z = z + Cells(x, k)
    [COLOR=Royalblue]Next[/COLOR]
    q = x + [COLOR=crimson]1[/COLOR]
[COLOR=Royalblue]Next[/COLOR]
Range([COLOR=brown]"H2"[/COLOR]) = z
Application.ScreenUpdating = [COLOR=Royalblue]True[/COLOR]
[COLOR=Royalblue]End[/COLOR] [COLOR=Royalblue]Sub[/COLOR][/FONT]

Edit:
If your data has decimal number, then change:
"z As Long" to "z As Double"
 
Last edited:

Watch MrExcel Video

Forum statistics

Threads
1,109,436
Messages
5,528,758
Members
409,834
Latest member
vexceled

This Week's Hot Topics

  • Change military grades into rank
    Afternoon all Need help with formula that will change military rank (i.e. 1, 2, 3 into Amn, A1C, SrA). Running IF formula that does not work...
  • VBA COUNTIF SOLUTION
    Hi The following are the errors spread across the several columns from E to Q ie. 13 columns across several sheets with more than 500 rows per...
  • INSERT ROW WITH SPECIFIS TEXT IN A COLUMN
    Hi All! How can identify that that the row to be inserted has to be inserted before 1st row with specific text in column F. If I record the...
  • Auto-Create a monthly Sign in sheet for preschool students
    The image below is what each page looks like. Above is space for the "Child Name" "Month" "Class" School days are obviously Monday-Friday but...
  • VBA vlookup multiple results
    Hi folks, Hopefully someone out there can help. I have a list to vlookup which works (ish). the lookup only picks up the first instance of the...
  • Extract values for earliest/latest times
    I am trying to put together a formula to get the earliest start time, the latest end time from column A for each person in Column B-F without the...
Top