Add Subtotals after inserting row

[Guest]

Sub EmptyRow()
Dim cou As Integer, MPStr As String, MPString As String
For cou = 1 To ActiveSheet.UsedRange.Rows.Count - 1
MPStr = Format(ActiveSheet.Cells(cou, 1), "YY")
MPString = Format(ActiveSheet.Cells(cou + 1, 1), "YY")
If Not Val(MPString) = Val(MPStr) Then
ActiveSheet.Rows(Trim(Str((cou + 1)))).Insert
cou = cou + 1
End If
Next
End Sub

I have above macro script which will add blank rows when year changes....But
need some more help to add subtotals after inserting rows.

Please see below is the data which I have in my excel sheet.
Invoice Date USD Amount GBP Amount
07-Jul-04 0.00 -545.63
07-Jul-04 -5,474.00 -2,991.54
23-Jul-04 -7,333.89 -3,962.19

13-Jun-05 -1,583.00 -843.27
01-Sep-05 -3,858.00 -2,158.94
16-Nov-05 1,104.00 632.74
01-Dec-05 -2,754.00 848.00
27-Dec-05 -1,778.00 -1,015.66
30-Dec-05 -581.00 -328.93

02-Feb-06 3,115.76 1,763.51
14-Feb-06 2,534.76 -956.54
16-Mar-06 2,416.61 1,389.52
16-Mar-06 -1,016.67 -584.58
17-Mar-06 -1,399.92 -804.94

29-Mar-07 1,159.00 661.91
30-Mar-07 2,439.57 1,388.95
01-Apr-07 6,357.54 3,660.16

Please advise if you require any further info.

Best Regards,
Kam.

 

[Dave Peterson]

How about an alternative?

Insert a new column that retrieves the year from the date:
=year(a2)
Then drag down as far as you need.

Then you can sort your data and use Data|Subtotals to get your total rows.

Another option would be to learn data|pivottable.

You can create some very nice summary tables and group your dates by year.

 

[Guest]

Actually I want total of both (USD & GBP) in each blank rows using VBA code...

 

[Guest]

I think you got confused with my comments..I have below mentioned script that
will add rows after years changes i.e 2004,2005,2006 & 2007 but I want to add
sub totals after inserting rows.

 

[Dave Peterson]

I wasn't confused. I just figured that you're trying to create a macro that
does pretty much what data|subtotal does.

 

[Guest]

I mean to say that my english is poor...so sorry for that...Is it possible to
add subtotals on each blank rows using VBA code....

 

[Dave Peterson]

I'm sure there is.

But you may find recording a macro when you remove the existing data|subtotals
and then reapplying data|subtotals does what you want and is easier to
code/record.

I mean to say that my english is poor...so sorry for that...Is it possible to
add subtotals on each blank rows using VBA code....

 

[Guest]

Yes I know that it is possible my using by recording macros but it won't be
suceessful every time bcoz blanks rows varies...

 

[Guest]

Hi I have tried to explain in simple way....Please Please give me macro which
can do that...please....please...

here is my problem ...

I have a worksheet with data in it .. in column"A" I have a date value ...
what i would like to do .. is

1) insert a row after a certain criteria is met ie.

Column A Column H
row 1 = 07/07/2004 100
row 2 = 23/07/2004 50
row 3 = 13/06/2005 30
row 4 = 01/09/2005 20
row 5 = 27/12/2005 10
row 6 = 02/02/2006 05
row 7 = 14/02/2006 07

I would want to insert a row between row 2 and 3 then 5 & 6...&...So
on...when year in dates change

2) I would like to total the numbers in column H above the column that I
just inserted

so basically trying to do a grouping with totals.

any help would be appreciated.

 

[Dave Peterson]

Maybe someone else will jump in.

Good luck.

Hi I have tried to explain in simple way....Please Please give me macro which
can do that...please....please...

here is my problem ...

I have a worksheet with data in it .. in column"A" I have a date value ...
what i would like to do .. is

1) insert a row after a certain criteria is met ie.

Column A Column H
row 1 = 07/07/2004 100
row 2 = 23/07/2004 50
row 3 = 13/06/2005 30
row 4 = 01/09/2005 20
row 5 = 27/12/2005 10
row 6 = 02/02/2006 05
row 7 = 14/02/2006 07

I would want to insert a row between row 2 and 3 then 5 & 6...&...So
on...when year in dates change

2) I would like to total the numbers in column H above the column that I
just inserted

so basically trying to do a grouping with totals.

any help would be appreciated.

 

[Guest]

Thanks Dave....Can anyone help please....

Maybe someone else will jump in.

Good luck.

 

[Guest]

Can any help please if it not possible to make this script then it's
fine...but please reply......

 

[AG]

Hello Kam
Yes it's possible to add totals, but you have to do it from the end to
start. This is because when inserting row the
ActiveSheet.UsedRange.Rows.Count wan't change and the For loop will
never reach the end.

Here are some "code samples" you can use with modification.
As you see I have added 3 new varibles,usd and gbp for total amount per
yaer and cou1 to ceap track of which row to put the sum.

First time cou1 allways goes in row ActiveSheet.UsedRange.Rows.Count +
1. Then you get the sum Looping from ActiveSheet.UsedRange.Rows.Count
and backwards until next year adding

usd = usd + ActiveSheet.Cells(cou, 2)
gbp = gbp + ActiveSheet.Cells(cou, 3)

here you must use cou1 to find how many rows down was it you inserted a
blank line and pu the next sum, the next time cou1 goes in the row

Sub EmptyRow()
Dim cou As Integer, MPStr As String, MPString As String, usd, gbp, cou1

For cou = ActiveSheet.UsedRange.Rows.Count - 1 To 2 Step -1

Hope this gives you an idea.

Regards
Anders

 

[AG]

Hello Kam
Give this a try. It is not the best macro but it'll do the job. If you
have a lot of rows on your worksheet, it will be faster with
application.screenupdating=false before the first For and
application.screenupdating=true as the last line before End Sub

Sub EmptyRow()
Dim cou As Integer, MPStr As String, MPString As String, usd, gbp,
cou1, twice
For twice = 0 To 1
Range("a1:c1").Copy Range("e1:g1")
cou1 = 2
For cou = 2 To ActiveSheet.UsedRange.Rows.Count - 1
ActiveSheet.Cells(cou1, 5) = ActiveSheet.Cells(cou, 1)
ActiveSheet.Cells(cou1, 6) = ActiveSheet.Cells(cou, 2)
ActiveSheet.Cells(cou1, 7) = ActiveSheet.Cells(cou, 3)

usd = usd + ActiveSheet.Cells(cou, 2)
gbp = gbp + ActiveSheet.Cells(cou, 3)

MPStr = Format(ActiveSheet.Cells(cou, 1), "YY")
MPString = Format(ActiveSheet.Cells(cou + 1, 1), "YY")
cou1 = cou1 + 1
If Not Val(MPString) = Val(MPStr) Then
If cou < ActiveSheet.UsedRange.Rows.Count Then
ActiveSheet.Cells(cou1, 6) = usd
ActiveSheet.Cells(cou1, 7) = gbp
Else
ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count + 1, 6) = usd
ActiveSheet.Cells(ActiveSheet.UsedRange.Rows.Count + 1, 7) = gbp

End If
cou1 = cou1 + 1
usd = 0: gbp = 0
End If
Next
Next
Columns("a:d").Select
Selection.Delete Shift:=xlToLeft
Range("a2").Select
End Sub