transfer name from date filed into new column and than subtotal

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I have exported data from other prg. Where I have filed like Date, Ref no.
Op. amt., Pending amt, due date and overdue date.

Where in date filed I have party name and dates want to transfer that name
from date filed into new column and than subtotal as per party name.

How do I transfer name from date filed into new column and than subtotal all
filed with party name.

Any Help thank in advance.

Shital
 
Thanks for Reply. Toppers

My Data layout is like...
a1, b1, c1, d1, e1,
f1
Date, Ref, Op. Amt, Pending Amt, Due date, Overdue day
00123ABC & Co.,
10-dec-05, 0101, 56700, 34099, 12-jan-06, 30
12-dec-05, 0102, 46100, 24090, 15-jan-06, 35
00125xyz & Co.,
17-dec-05, 0111, 56700, 4092, 22-jan-06, 30
22-dec-05, 0002, 23160, 1790, 25-jan-06, 15
29-dec-05, 0501, 16800, 2099, 12-jan-06, 20
31-dec-05, 0302, 86120, 6000, 25-jan-06, 33

I want output like...

A1, b1, c1, d1, e1,
f1, g1
Party, Date, Ref, Op. Amt, Pending Amt, Due
date, Overdue
00123ABC & Co.,10-dec-05, 0101, 56700, 34099, 12-jan-06, 30
00123ABC & Co.,12-dec-05, 0102, 46100, 24090, 15-jan-06, 35
Party subtotal 102800 58189
00125xyz & Co.,17-dec-05, 0111, 56700, 4092, 22-jan-06,
30
00125xyz & Co.,22-dec-05, 0002, 23160, 1790, 25-jan-06,
15
00125xyz & Co.,29-dec-05, 0501, 16800, 2099, 12-jan-06,
20
00125xyz & Co.,31-dec-05, 0302, 86120, 6000, 25-jan-06,
33
Party Subtotal 345590 13451
any help
 
Hi,
Try this:

Sub SumByParty()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long, srow As Long, nrow As Long
Dim OpAmt As Double, PendAmt As Double

Set ws1 = Worksheets("Sheet1") ' <=== Change
Set ws2 = Worksheets("Sheet2") ' <=== Change

ws1.Activate
With ws1

lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
ws2.Range("a1:g1") = Array("Party", "Date", "Ref", "Op. Amt", "Pending
Amt", "Due date", "Overdue Date")

Set Outrng = ws2.Range("a2")
srow = 2
r = 2

Do
OpAmt = .Cells(r, 3)
PendAmt = .Cells(r, 4)
r = r + 1
Do While .Cells(r, 7) = "" And r <= lastrow
OpAmt = OpAmt + .Cells(r, 3)
PendAmt = PendAmt + .Cells(r, 4)
r = r + 1
Loop
nrow = r - srow
.Cells(srow, 1).Resize(nrow, 6).Copy Outrng.Offset(0, 1)
Outrng.Resize(nrow) = .Cells(srow, 7)
Outrng.Offset(nrow + 1, 3) = OpAmt
Outrng.Offset(nrow + 1, 4) = PendAmt
Set Outrng = Outrng.Offset(nrow + 4, 0)
srow = r
Loop While r <= lastrow

End With
End Sub
 
Thanks you very much it's working..
But i want subtotal at end of each party dates are over and not end of the
data, is this possible? one more thing can party name come below party filed.

thanks again for reply.

Shital
 
Shital,
Is this what you want? If not, send me an example workbook
([email protected])

Sub SumByParty()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastrow As Long, r As Long, srow As Long, nrow As Long
Dim OpAmt As Double, PendAmt As Double

Set ws1 = Worksheets("Sheet1") ' <=== Change
Set ws2 = Worksheets("Sheet2") ' <=== Change

ws1.Activate
With ws1

lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
ws2.Range("a1:g1") = Array("Party", "Date", "Ref", "Op. Amt", "Pending
Amt", "Due date", "Overdue Date")

Set Outrng = ws2.Range("a2")
srow = 2
r = 2

Do
OpAmt = .Cells(r, 3)
PendAmt = .Cells(r, 4)
r = r + 1
Do While .Cells(r, 7) = "" And r <= lastrow
OpAmt = OpAmt + .Cells(r, 3)
PendAmt = PendAmt + .Cells(r, 4)
r = r + 1
Loop
nrow = r - srow
.Cells(srow, 1).Resize(nrow, 6).Copy Outrng.Offset(0, 1)
Outrng.Resize(nrow) = .Cells(srow, 7)
Outrng.Offset(nrow - 1, 7) = OpAmt
Outrng.Offset(nrow - 1, 8) = PendAmt
Set Outrng = Outrng.Offset(nrow + 1, 0)
srow = r
Loop While r <= lastrow

End With
End Sub
 
Back
Top