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




"****al shah" wrote:

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



सà¤*ी विसà¥�तृत करेंसà¤*ी संकà¥�षिपà¥�त करें