Pls Help in code given

[Guest]

ref no opening amt pending amt due date overdue days
100000 - Corporation Bank
31-Mar-05 1434 -13206 -13206 31-Mar-05 453
31-May-05 OM000 -32434 -25750 31-May-05 392
15-Jun-05 OM0020 -79079 -79079 15-Jun-05 377
30-Nov-05 OM010 -22.04 -22.04 30-Nov-05 209
100003 - HDFC Bank
15-Jun-05 OM00220 -1388.52 -1388.52 15-Jun-05 377

I have Data like this and I got code also for do total of all opening amount
& pending amount when date is
change and also transfer party name into new column i.e. on "A column" But
now i want to modify code i done want to
transfer party name into A column. i done have more knowledge of VBA can any
one will help.

code is given below.

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("Data") ' <=== Change
Set ws2 = Worksheets("Output Report") ' <=== 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 = 0
PendAmt = 0
r = r + 1
Do While IsDate(.Cells(r, 1)) And r <= lastrow
OpAmt = OpAmt + .Cells(r, 3)
PendAmt = PendAmt + .Cells(r, 4)
r = r + 1
Loop
OutRng.Value = .Cells(srow, 1)
nrow = r - srow - 1
.Cells(srow + 1, 1).Resize(nrow, 6).Copy OutRng.Offset(0, 1)
OutRng.Offset(nrow, 3) = OpAmt
OutRng.Offset(nrow, 4) = PendAmt
OutRng.Offset(nrow, 3).Resize(1, 2).Font.Bold = True
Set OutRng = OutRng.Offset(nrow + 1, 0)
srow = r
Loop While r <= lastrow

End With
End Sub



सभी विसà¥à¤¤à¥ƒà¤¤ करेंसभी संकà¥à¤·à¤¿à¤ªà¥à¤¤ करें

 

[Guest]

Based on my interpretation of your request, if you simply convert the
following line to comment text by putting an apostrophe in front as such:

'OutRng.Value = .Cells(srow, 1)

then it will do what you want. If this is correct, then after thorough
testing you can delete the line. Following is a slight rewrite of your code
with minor simplification. Note that the OutRng variable was not declared in
the original code. I have corrected this. Code execution should be slightly
more efficient when declared.

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
Dim OutRng As Range

Set ws1 = Worksheets("Data") ' <=== Change
Set ws2 = Worksheets("Output Report") ' <=== Change
ws1.Activate
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
With ws1
lastrow = .Cells(Rows.Count, 1).End(xlUp).Row
Do
OpAmt = 0
PendAmt = 0
r = r + 1
Do While IsDate(.Cells(r, 1)) And r <= lastrow
OpAmt = OpAmt + .Cells(r, 3)
PendAmt = PendAmt + .Cells(r, 4)
r = r + 1
Loop
'OutRng.Value = .Cells(srow, 1)
nrow = r - srow - 1
.Cells(srow + 1, 1).Resize(nrow, 6).Copy OutRng.Offset(0, 1)
OutRng.Offset(nrow, 3) = OpAmt
OutRng.Offset(nrow, 4) = PendAmt
OutRng.Offset(nrow, 3).Resize(1, 2).Font.Bold = True
Set OutRng = OutRng.Offset(nrow + 1, 0)
srow = r
Loop While r <= lastrow
End With
End Sub

Regards,
Greg

 

[Guest]

thanks Greg Wilson for reply. It working but i want Party name to be there
above date. with this code it delete party name I want party name also.

Is this possible.

thanks

Shital

 

[Guest]

Sorry, I don't understand your request. I thought that was what you wanted. I
suggest that you:

1. List some simple example data under the heading "Example data from Data
worksheet:"
2. List the current output data (that results from the macro as it is
currently written) under the heading "Current output data from Output Report
worksheet:"
3. List the desired output data under the heading "Desired output data from
Output Report worksheet:"
4. The macro appears to be written to account for gaps in the date data in
column A of sheet Data due to grouping of data. I suggest that you either
avoid gaps in the example data or indicate gaps with the word "blank".

Regards,
Greg

 

[Guest]

Greg
Thanks for suggestion i am sending data as per ur suggestion.

Example data from Data worksheet
Date ref no opening amount pending amount due date overdue days
Auto Comp. Blank Row
15-Apr-04 80037 -1469 -1469 15-Apr-04 641
30-Apr-04 80065 -1609 -1609 30-Apr-04 626
15-May-04 80090 -86 -86 15-May-04 611

Pink & Pink Blank Row
15-Aug-05 MAA001000506 -3173.6 -1189.6 15-Aug-05 154
31-Aug-05 MAA001070506 -10076.7 -10076.7 31-Aug-05 138
31-Oct-05 MAA001580506 -357.05 -357.05 31-Oct-05 77
15-Nov-05 MAA001770506 -79.34 -79.34 15-Nov-05 62


Current output data from Output Report
Worksheet

Party Data ref no opening amount pending amount due date overdue days
Auto Comp. Blank row
15-Apr-04 80037 -1469 -1469 15-Apr-04 641
30-Apr-04 80065 -1609 -1609 30-Apr-04 626
15-May-04 80090 -86 -86 15-May-04 611
Total -3164 -3164

Pink & Pink Blank row
15-Aug-05 MAA001000506 -3173.6 -1189.6 15-Aug-05 154
31-Aug-05 MAA001070506 -10076.7 -10076.7 31-Aug-05 138
31-Oct-05 MAA001580506 -357.05 -357.05 31-Oct-05 77
15-Nov-05 MAA001770506 -79.34 -79.34 15-Nov-05 62

Total -14202. -12218.42

Desired output data from Output Report worksheet
Date ref no opening amount pending amount due date overdue days
Auto Comp. Blank Row
15-Apr-04 80037 -1469 -1469 15-Apr-04 641
30-Apr-04 80065 -1609 -1609 30-Apr-04 626
15-May-04 80090 -86 -86 15-May-04 611
Total -3164 -3164
Pink & Pink Blank Row
15-Aug-05 MAA001000506 -3173.6 -1189.6 15-Aug-05 154
31-Aug-05 MAA001070506 -10076.7 -10076.7 31-Aug-05 138
31-Oct-05 MAA001580506 -357.05 -357.05 31-Oct-05 77
15-Nov-05 MAA001770506 -79.34 -79.34 15-Nov-05 62
Total -14202. -12218.42
pls look into it and if you want file i send you
Shital