Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will be
changing on a monthly basis.

Nat,

Is this what you want?

Dim i As Long
Dim cLastRow As Long
Dim iRow As Long
Dim nACcount As Long
Dim nBalance As Long
Dim fFirst As Boolean

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value < nACcount Then
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
nBalance = 0
iRow = iRow + 1
End If
nBalance = nBalance + Cells(i, "C").Value
Cells(i, "A").EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
iRow = iRow + 1
Next i
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"nat" wrote in message
...
Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will be
changing on a monthly basis.

Bob
I'm not very familiar with the code but I think it should
have one more condition:
- if the balance per account is equal or greater
than $50.00, than it should copy the rows to another sheet
- if not, than no copy needed.

Can you modify to reflect this condition? Thank you.

-----Original Message-----
Nat,

Is this what you want?

Dim i As Long
Dim cLastRow As Long
Dim iRow As Long
Dim nACcount As Long
Dim nBalance As Long
Dim fFirst As Boolean

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value < nACcount Then
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
nBalance = 0
iRow = iRow + 1
End If
nBalance = nBalance + Cells(i, "C").Value
Cells(i, "A").EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
iRow = iRow + 1
Next i
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"nat" wrote in
message
...
Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will be
changing on a monthly basis.



.

Nat,

Sorry about that. I noticed the condition, but built the basic code first,
and then forgot it.

Try this instead

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - 1 - iStart + 1
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + 1, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"nat" wrote in message
...
Bob
I'm not very familiar with the code but I think it should
have one more condition:
- if the balance per account is equal or greater
than $50.00, than it should copy the rows to another sheet
- if not, than no copy needed.

Can you modify to reflect this condition? Thank you.

-----Original Message-----
Nat,

Is this what you want?

Dim i As Long
Dim cLastRow As Long
Dim iRow As Long
Dim nACcount As Long
Dim nBalance As Long
Dim fFirst As Boolean

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value < nACcount Then
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
nBalance = 0
iRow = iRow + 1
End If
nBalance = nBalance + Cells(i, "C").Value
Cells(i, "A").EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
iRow = iRow + 1
Next i
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"nat" wrote in
message
...
Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will be
changing on a monthly basis.



.

Bob,
Thank you very much for the code. When I've tried to run
it, i've got a syntax error in Destination:= line. Any
idea why?
-----Original Message-----
Nat,

Sorry about that. I noticed the condition, but built the
basic code first,
and then forgot it.

Try this instead

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - 1 - iStart + 1
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + 1, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"nat" wrote in
message
...
Bob
I'm not very familiar with the code but I think it
should
have one more condition:
- if the balance per account is equal or greater
than $50.00, than it should copy the rows to another
sheet
- if not, than no copy needed.

Can you modify to reflect this condition? Thank you.

-----Original Message-----
Nat,

Is this what you want?

Dim i As Long
Dim cLastRow As Long
Dim iRow As Long
Dim nACcount As Long
Dim nBalance As Long
Dim fFirst As Boolean

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value < nACcount Then
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
nBalance = 0
iRow = iRow + 1
End If
nBalance = nBalance + Cells(i, "C").Value
Cells(i, "A").EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
iRow = iRow + 1
Next i
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the
Purbecks
(remove nothere from the email address if mailing
direct)

"nat" wrote in
message
...
Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on
Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or
greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are
copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will be
changing on a monthly basis.



.



.

I haven't been following along here, but it looks like the "line
continuation" character(underscore followed by a space) in the middle of the
Copy statement is missing, i.e.:

Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells(iRow, "A")

Could just be the formatting on my screen, but it looks suspicious.

hth,

Doug


"nat" wrote in message
...
Bob,
Thank you very much for the code. When I've tried to run
it, i've got a syntax error in Destination:= line. Any
idea why?
-----Original Message-----
Nat,

Sorry about that. I noticed the condition, but built the
basic code first,
and then forgot it.

Try this instead

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - 1 - iStart + 1
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + 1, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"nat" wrote in
message
...
Bob
I'm not very familiar with the code but I think it
should
have one more condition:
- if the balance per account is equal or greater
than $50.00, than it should copy the rows to another
sheet
- if not, than no copy needed.

Can you modify to reflect this condition? Thank you.

-----Original Message-----
Nat,

Is this what you want?

Dim i As Long
Dim cLastRow As Long
Dim iRow As Long
Dim nACcount As Long
Dim nBalance As Long
Dim fFirst As Boolean

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value < nACcount Then
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
nBalance = 0
iRow = iRow + 1
End If
nBalance = nBalance + Cells(i, "C").Value
Cells(i, "A").EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
iRow = iRow + 1
Next i
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the
Purbecks
(remove nothere from the email address if mailing
direct)

"nat" wrote in
message
...
Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on
Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or
greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are
copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will be
changing on a monthly basis.



.



.

Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test table, the
total on sheet2 for the las account "3333" is correct
(=210) but only one row (with $200 balance) shows up. Any
idea why the row with $10 balance is not showing? Can you
correct the code? Thank you in advance.
-----Original Message-----
I haven't been following along here, but it looks like
the "line
continuation" character(underscore followed by a space)
in the middle of the
Copy statement is missing, i.e.:

Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells(iRow, "A")

Could just be the formatting on my screen, but it looks
suspicious.

hth,

Doug


"nat" wrote in
message
...
Bob,
Thank you very much for the code. When I've tried to
run
it, i've got a syntax error in Destination:= line. Any
idea why?
-----Original Message-----
Nat,

Sorry about that. I noticed the condition, but built
the
basic code first,
and then forgot it.

Try this instead

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - 1 - iStart + 1
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + 1, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the
Purbecks
(remove nothere from the email address if mailing
direct)

"nat" wrote in
message
...
Bob
I'm not very familiar with the code but I think it
should
have one more condition:
- if the balance per account is equal or greater
than $50.00, than it should copy the rows to another
sheet
- if not, than no copy needed.

Can you modify to reflect this condition? Thank you.

-----Original Message-----
Nat,

Is this what you want?

Dim i As Long
Dim cLastRow As Long
Dim iRow As Long
Dim nACcount As Long
Dim nBalance As Long
Dim fFirst As Boolean

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value < nACcount Then
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
nBalance = 0
iRow = iRow + 1
End If
nBalance = nBalance + Cells(i, "C").Value
Cells(i, "A").EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
iRow = iRow + 1
Next i
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the
Purbecks
(remove nothere from the email address if mailing
direct)

"nat" wrote in
message
...
Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on
Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or
greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are
copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will
be
changing on a monthly basis.



.



.



.

nat,

I am at work now. If no one else answers this I'll try to figure out later.

Doug

"nat" wrote in message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test table, the
total on sheet2 for the las account "3333" is correct
(=210) but only one row (with $200 balance) shows up. Any
idea why the row with $10 balance is not showing? Can you
correct the code? Thank you in advance.
-----Original Message-----
I haven't been following along here, but it looks like
the "line
continuation" character(underscore followed by a space)
in the middle of the
Copy statement is missing, i.e.:

Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells(iRow, "A")

Could just be the formatting on my screen, but it looks
suspicious.

hth,

Doug


"nat" wrote in
message
...
Bob,
Thank you very much for the code. When I've tried to
run
it, i've got a syntax error in Destination:= line. Any
idea why?
-----Original Message-----
Nat,

Sorry about that. I noticed the condition, but built
the
basic code first,
and then forgot it.

Try this instead

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - 1 - iStart + 1
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + 1, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the
Purbecks
(remove nothere from the email address if mailing
direct)

"nat" wrote in
message
...
Bob
I'm not very familiar with the code but I think it
should
have one more condition:
- if the balance per account is equal or greater
than $50.00, than it should copy the rows to another
sheet
- if not, than no copy needed.

Can you modify to reflect this condition? Thank you.

-----Original Message-----
Nat,

Is this what you want?

Dim i As Long
Dim cLastRow As Long
Dim iRow As Long
Dim nACcount As Long
Dim nBalance As Long
Dim fFirst As Boolean

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value < nACcount Then
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
nBalance = 0
iRow = iRow + 1
End If
nBalance = nBalance + Cells(i, "C").Value
Cells(i, "A").EntireRow.Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
iRow = iRow + 1
Next i
nACcount = Cells(i, "B").Value
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With

End Sub


--

HTH

Bob Phillips
... looking out across Poole Harbour to the
Purbecks
(remove nothere from the email address if mailing
direct)

"nat" wrote in
message
...
Hello,
Can someone help with the code, please?
Here is the example of the table (let's say on
Sheet1):
A B C
1 Depart Num Acct Num Acct Balance
2 01 1111 100.00
3 02 1111 50.00
4 03 2222 150.00
5 01 3333 200.00
6 05 3333 10.00

I need the macro to do the following:
- if the total balance per account is equal or
greater
than $50
- select all rows for that account, and
- copy them to Sheet2
- after all rows (meeting the requirements are
copied),
insert lines to subtotal balance for each account.
Note: the number of rows in the first table will
be
changing on a monthly basis.



.



.



.

Nat,

I modified a line in the last copy section and it seems to work. Also, I
wrote another routine for you. It's the first one below. You can run it
from sheet1 or sheet2 or elsewhere in the workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets("Sheet1").Ro ws.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize(copy_ range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells(rw.Row - 1 + group_count,
"C")
sum_cell.Formula = "=sum(" & sum_cell.Offset(-1, 0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count, 0).Address & ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets("Sheet1").Range(Rows(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + iEnd - iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat" wrote in message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test table, the
total on sheet2 for the las account "3333" is correct
(=210) but only one row (with $200 balance) shows up. Any
idea why the row with $10 balance is not showing? Can you
correct the code? Thank you in advance.

Doug,
Thank you very much. It works!!!!!!!!! Is there any way
to modify the code to format the total balance lines (on
sheet2)like this: Acct 1111 Total 150 (in bold surrounded
by top and bottom border lines)?
-----Original Message-----
Nat,

I modified a line in the last copy section and it seems
to work. Also, I
wrote another routine for you. It's the first one
below. You can run it
from sheet1 or sheet2 or elsewhere in the workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets
("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells(rw.Row -
1 + group_count,
"C")
sum_cell.Formula = "=sum(" & sum_cell.Offset(-1,
0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count, 0).Address & ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets("Sheet1").Range(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets
("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + iEnd -
iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat" wrote in
message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test table, the
total on sheet2 for the las account "3333" is correct
(=210) but only one row (with $200 balance) shows up.
Any
idea why the row with $10 balance is not showing? Can
you
correct the code? Thank you in advance.


.

Nat,

I cleaned up a couple of other things and made the changes you're looking
for. The code is getting longer! Let me know how this works for you:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Application.ScreenUpdating = False
Worksheets("Sheet2").Cells.Font.Bold = False
On Error GoTo error
Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets("Sheet1").Ro ws.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize(copy_ range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy
Worksheets("Sheet2").Cells(rw.Row - 1 + group_count -
copy_range.Rows.Count, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Set sum_cell = Worksheets("Sheet2").Cells(rw.Row - 1 + group_count,
"C")

With sum_cell
.Formula = "=sum(" & .Offset(-1, 0).Address & ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(* (#,##0);_(*
""-""??_);_(@_)"
.Offset(0, -2) = "Acct "
.Offset(0, -1) = .Offset(-1, -1)
With Range(.Offset(0, -2).Address, .Offset(0, 0).Address)
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
End With
End With
Set copy_range = Worksheets("Sheet1").Range(Rows(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel < 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

Worksheets("Sheet2").Range("A1").Select

error:
Application.ScreenUpdating = True

End Sub

hth,

Doug


wrote in message
...
Doug,
Thank you very much. It works!!!!!!!!! Is there any way
to modify the code to format the total balance lines (on
sheet2)like this: Acct 1111 Total 150 (in bold surrounded
by top and bottom border lines)?
-----Original Message-----
Nat,

I modified a line in the last copy section and it seems
to work. Also, I
wrote another routine for you. It's the first one
below. You can run it
from sheet1 or sheet2 or elsewhere in the workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets
("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells(rw.Row -
1 + group_count,
"C")
sum_cell.Formula = "=sum(" & sum_cell.Offset(-1,
0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count, 0).Address & ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets("Sheet1").Range(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets
("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + iEnd -
iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat" wrote in
message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test table, the
total on sheet2 for the las account "3333" is correct
(=210) but only one row (with $200 balance) shows up.
Any
idea why the row with $10 balance is not showing? Can
you
correct the code? Thank you in advance.


.

Hi Doug,
Thanks for being there for me. When I've tried to copy
the code, the section below was highlighted in red (giving
me a compile error: end of statement required). I was
able to fix the .Formula line by deleting an extra period
(if it is in fact extra) before the Offset.
But .NumberFormat line is still highlighted in red with
the cursor blinking on the secon ? sign in (*""-""??_).
Any idea why?
Some day I hope to learn what all of these means. Thank
you for all of you help.


With sum_cell
.Formula = "=sum(" & .Offset(-1, 0).Address
& ":" &
...Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"





-----Original Message-----
Nat,

I cleaned up a couple of other things and made the
changes you're looking
for. The code is getting longer! Let me know how this
works for you:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Application.ScreenUpdating = False
Worksheets("Sheet2").Cells.Font.Bold = False
On Error GoTo error
Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy
Worksheets("Sheet2").Cells(rw.Row - 1 +
group_count -
copy_range.Rows.Count, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Set sum_cell = Worksheets("Sheet2").Cells(rw.Row -
1 + group_count,
"C")

With sum_cell
.Formula = "=sum(" & .Offset(-1, 0).Address
& ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"
.Offset(0, -2) = "Acct "
.Offset(0, -1) = .Offset(-1, -1)
With Range(.Offset(0, -2).Address, .Offset(0,
0).Address)
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
End With
End With
Set copy_range = Worksheets("Sheet1").Range(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel < 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

Worksheets("Sheet2").Range("A1").Select

error:
Application.ScreenUpdating = True

End Sub

hth,

Doug


wrote in message
...
Doug,
Thank you very much. It works!!!!!!!!! Is there any
way
to modify the code to format the total balance lines (on
sheet2)like this: Acct 1111 Total 150 (in bold
surrounded
by top and bottom border lines)?
-----Original Message-----
Nat,

I modified a line in the last copy section and it seems
to work. Also, I
wrote another routine for you. It's the first one
below. You can run it
from sheet1 or sheet2 or elsewhere in the workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets
("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")
sum_cell.Formula = "=sum(" & sum_cell.Offset(-
1,
0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count, 0).Address
& ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets
("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + iEnd -
iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat" wrote in
message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test table,
the
total on sheet2 for the las account "3333" is correct
(=210) but only one row (with $200 balance) shows up.
Any
idea why the row with $10 balance is not showing?
Can
you
correct the code? Thank you in advance.


.



.

Nat,

Don't know how I got the extra period in there, it's not in the code in my
worksheet - anyways you fixed it.

For the NumberFormat line, the following code needs to be all one line in
the VBE (the editor):

.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"

Just be sure to leave the space that's after each of the asterisks. (You
could use a continuation character in VBE, which allows you to have lines of
code on more than one line in the editor, but since the character is an
underscore followed by a space (_ ) and can't be inside quotes, it might
drive you crazy trying to put them in the right place.)

So again just put the above code back onto one line, being sure to not to
delete the space that follows each asterisk

I hope that makes sense. Let me know.

Doug

"Nat" wrote in message
...
Hi Doug,
Thanks for being there for me. When I've tried to copy
the code, the section below was highlighted in red (giving
me a compile error: end of statement required). I was
able to fix the .Formula line by deleting an extra period
(if it is in fact extra) before the Offset.
But .NumberFormat line is still highlighted in red with
the cursor blinking on the secon ? sign in (*""-""??_).
Any idea why?
Some day I hope to learn what all of these means. Thank
you for all of you help.


With sum_cell
.Formula = "=sum(" & .Offset(-1, 0).Address
& ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"





-----Original Message-----
Nat,

I cleaned up a couple of other things and made the
changes you're looking
for. The code is getting longer! Let me know how this
works for you:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Application.ScreenUpdating = False
Worksheets("Sheet2").Cells.Font.Bold = False
On Error GoTo error
Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy
Worksheets("Sheet2").Cells(rw.Row - 1 +
group_count -
copy_range.Rows.Count, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Set sum_cell = Worksheets("Sheet2").Cells(rw.Row -
1 + group_count,
"C")

With sum_cell
.Formula = "=sum(" & .Offset(-1, 0).Address & ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"
.Offset(0, -2) = "Acct "
.Offset(0, -1) = .Offset(-1, -1)
With Range(.Offset(0, -2).Address, .Offset(0,
0).Address)
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
End With
End With
Set copy_range = Worksheets("Sheet1").Range(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel < 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

Worksheets("Sheet2").Range("A1").Select

error:
Application.ScreenUpdating = True

End Sub

hth,

Doug


wrote in message
...
Doug,
Thank you very much. It works!!!!!!!!! Is there any
way
to modify the code to format the total balance lines (on
sheet2)like this: Acct 1111 Total 150 (in bold
surrounded
by top and bottom border lines)?
-----Original Message-----
Nat,

I modified a line in the last copy section and it seems
to work. Also, I
wrote another routine for you. It's the first one
below. You can run it
from sheet1 or sheet2 or elsewhere in the workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets
("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")
sum_cell.Formula = "=sum(" & sum_cell.Offset(-
1,
0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count, 0).Address
& ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets
("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
With Worksheets("Sheet2").Cells(iRow + iEnd -
iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat" wrote in
message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test table,
the
total on sheet2 for the las account "3333" is correct
(=210) but only one row (with $200 balance) shows up.
Any
idea why the row with $10 balance is not showing?
Can
you
correct the code? Thank you in advance.


.



.

Doug,
I fixed as you suggested and the macro ran fine with one
little problem: total acct lines on sheet2 were not
bolded and not surrounded with top and bottom border
lines. Instead, these lines and the bold format appeared
on sheet1 (which I do need). Can you try to fix it one
more time? (hopefully the last). Thank you.

-----Original Message-----
Nat,

Don't know how I got the extra period in there, it's not
in the code in my
worksheet - anyways you fixed it.

For the NumberFormat line, the following code needs to be
all one line in
the VBE (the editor):

.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"

Just be sure to leave the space that's after each of the
asterisks. (You
could use a continuation character in VBE, which allows
you to have lines of
code on more than one line in the editor, but since the
character is an
underscore followed by a space (_ ) and can't be inside
quotes, it might
drive you crazy trying to put them in the right place.)

So again just put the above code back onto one line,
being sure to not to
delete the space that follows each asterisk

I hope that makes sense. Let me know.

Doug

"Nat" wrote in
message
...
Hi Doug,
Thanks for being there for me. When I've tried to copy
the code, the section below was highlighted in red
(giving
me a compile error: end of statement required). I was
able to fix the .Formula line by deleting an extra
period
(if it is in fact extra) before the Offset.
But .NumberFormat line is still highlighted in red with
the cursor blinking on the secon ? sign in (*""-""??_).
Any idea why?
Some day I hope to learn what all of these means. Thank
you for all of you help.


With sum_cell
.Formula = "=sum(" & .Offset(-1, 0).Address
& ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"





-----Original Message-----
Nat,

I cleaned up a couple of other things and made the
changes you're looking
for. The code is getting longer! Let me know how this
works for you:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Application.ScreenUpdating = False
Worksheets("Sheet2").Cells.Font.Bold = False
On Error GoTo error
Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy
Worksheets("Sheet2").Cells(rw.Row - 1 +
group_count -
copy_range.Rows.Count, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")

With sum_cell
.Formula = "=sum(" & .Offset(-1,
0).Address & ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"
.Offset(0, -2) = "Acct "
.Offset(0, -1) = .Offset(-1, -1)
With Range(.Offset(0, -2).Address, .Offset
(0,
0).Address)
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
End With
End With
Set copy_range = Worksheets("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel < 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

Worksheets("Sheet2").Range("A1").Select

error:
Application.ScreenUpdating = True

End Sub

hth,

Doug


wrote in message
...
Doug,
Thank you very much. It works!!!!!!!!! Is there any
way
to modify the code to format the total balance lines
(on
sheet2)like this: Acct 1111 Total 150 (in bold
surrounded
by top and bottom border lines)?
-----Original Message-----
Nat,

I modified a line in the last copy section and it
seems
to work. Also, I
wrote another routine for you. It's the first one
below. You can run it
from sheet1 or sheet2 or elsewhere in the workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows
(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets
("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")
sum_cell.Formula = "=sum(" & sum_cell.Offset
(-
1,
0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count, 0).Address
& ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells
(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets
("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
With Worksheets("Sheet2").Cells(iRow +
iEnd -
iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat" wrote in
message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test
table,
the
total on sheet2 for the las account "3333" is
correct
(=210) but only one row (with $200 balance) shows
up.
Any
idea why the row with $10 balance is not showing?
Can
you
correct the code? Thank you in advance.


.



.



.

Nat,

Sorry to draw this out. My inexperience is showing. That said, the fix is
simple (knock on wood).

Change the line:

With Range(.Offset(0, -2).Address, .Offset(0, 0).Address)
to
With Worksheets("Sheet2").Range(.Offset(0, -2).Address,
..Offset(0, 0).Address)

That works for me. Let me know if it works for you.

Doug


wrote in message
...
Doug,
I fixed as you suggested and the macro ran fine with one
little problem: total acct lines on sheet2 were not
bolded and not surrounded with top and bottom border
lines. Instead, these lines and the bold format appeared
on sheet1 (which I do need). Can you try to fix it one
more time? (hopefully the last). Thank you.

-----Original Message-----
Nat,

Don't know how I got the extra period in there, it's not
in the code in my
worksheet - anyways you fixed it.

For the NumberFormat line, the following code needs to be
all one line in
the VBE (the editor):

.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"

Just be sure to leave the space that's after each of the
asterisks. (You
could use a continuation character in VBE, which allows
you to have lines of
code on more than one line in the editor, but since the
character is an
underscore followed by a space (_ ) and can't be inside
quotes, it might
drive you crazy trying to put them in the right place.)

So again just put the above code back onto one line,
being sure to not to
delete the space that follows each asterisk

I hope that makes sense. Let me know.

Doug

"Nat" wrote in
message
...
Hi Doug,
Thanks for being there for me. When I've tried to copy
the code, the section below was highlighted in red
(giving
me a compile error: end of statement required). I was
able to fix the .Formula line by deleting an extra
period
(if it is in fact extra) before the Offset.
But .NumberFormat line is still highlighted in red with
the cursor blinking on the secon ? sign in (*""-""??_).
Any idea why?
Some day I hope to learn what all of these means. Thank
you for all of you help.


With sum_cell
.Formula = "=sum(" & .Offset(-1, 0).Address
& ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"





-----Original Message-----
Nat,

I cleaned up a couple of other things and made the
changes you're looking
for. The code is getting longer! Let me know how this
works for you:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Application.ScreenUpdating = False
Worksheets("Sheet2").Cells.Font.Bold = False
On Error GoTo error
Set copy_range = Worksheets("Sheet1").Rows(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy
Worksheets("Sheet2").Cells(rw.Row - 1 +
group_count -
copy_range.Rows.Count, 1).PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")

With sum_cell
.Formula = "=sum(" & .Offset(-1,
0).Address & ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"
.Offset(0, -2) = "Acct "
.Offset(0, -1) = .Offset(-1, -1)
With Range(.Offset(0, -2).Address, .Offset
(0,
0).Address)
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
End With
End With
Set copy_range = Worksheets("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel < 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

Worksheets("Sheet2").Range("A1").Select

error:
Application.ScreenUpdating = True

End Sub

hth,

Doug


wrote in message
...
Doug,
Thank you very much. It works!!!!!!!!! Is there any
way
to modify the code to format the total balance lines
(on
sheet2)like this: Acct 1111 Total 150 (in bold
surrounded
by top and bottom border lines)?
-----Original Message-----
Nat,

I modified a line in the last copy section and it
seems
to work. Also, I
wrote another routine for you. It's the first one
below. You can run it
from sheet1 or sheet2 or elsewhere in the workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows
(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets
("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")
sum_cell.Formula = "=sum(" & sum_cell.Offset
(-
1,
0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count, 0).Address
& ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells
(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets
("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets("Sheet2").Cells
(iRow, "A")
With Worksheets("Sheet2").Cells(iRow +
iEnd -
iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat" wrote in
message
...
Thank you Doug.
The continuation character fixed the syntax error;
however, when I've tried to run it on my test
table,
the
total on sheet2 for the las account "3333" is
correct
(=210) but only one row (with $200 balance) shows
up.
Any
idea why the row with $10 balance is not showing?
Can
you
correct the code? Thank you in advance.


.



.



.

Doug,
It WORKS!!!!!!!!!!!!!! Thank you and happy holidays!
-----Original Message-----
Nat,

Sorry to draw this out. My inexperience is showing.
That said, the fix is
simple (knock on wood).

Change the line:

With Range(.Offset(0, -2).Address, .Offset(0,
0).Address)
to
With Worksheets("Sheet2").Range(.Offset(0, -
2).Address,
..Offset(0, 0).Address)

That works for me. Let me know if it works for you.

Doug


wrote in message
...
Doug,
I fixed as you suggested and the macro ran fine with one
little problem: total acct lines on sheet2 were not
bolded and not surrounded with top and bottom border
lines. Instead, these lines and the bold format
appeared
on sheet1 (which I do need). Can you try to fix it one
more time? (hopefully the last). Thank you.

-----Original Message-----
Nat,

Don't know how I got the extra period in there, it's
not
in the code in my
worksheet - anyways you fixed it.

For the NumberFormat line, the following code needs to
be
all one line in
the VBE (the editor):

.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"

Just be sure to leave the space that's after each of
the
asterisks. (You
could use a continuation character in VBE, which allows
you to have lines of
code on more than one line in the editor, but since
the
character is an
underscore followed by a space (_ ) and can't be inside
quotes, it might
drive you crazy trying to put them in the right place.)

So again just put the above code back onto one line,
being sure to not to
delete the space that follows each asterisk

I hope that makes sense. Let me know.

Doug

"Nat" wrote in
message
...
Hi Doug,
Thanks for being there for me. When I've tried to
copy
the code, the section below was highlighted in red
(giving
me a compile error: end of statement required). I
was
able to fix the .Formula line by deleting an extra
period
(if it is in fact extra) before the Offset.
But .NumberFormat line is still highlighted in red
with
the cursor blinking on the secon ? sign in (*""-""??
_).
Any idea why?
Some day I hope to learn what all of these means.
Thank
you for all of you help.


With sum_cell
.Formula = "=sum(" & .Offset(-1,
0).Address
& ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_(*
(#,##0);_(*
""-""??_);_(@_)"





-----Original Message-----
Nat,

I cleaned up a couple of other things and made the
changes you're looking
for. The code is getting longer! Let me know how
this
works for you:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Application.ScreenUpdating = False
Worksheets("Sheet2").Cells.Font.Bold = False
On Error GoTo error
Set copy_range = Worksheets("Sheet1").Rows
(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy
Worksheets("Sheet2").Cells(rw.Row - 1 +
group_count -
copy_range.Rows.Count, 1).PasteSpecial
Paste:=xlValues
Application.CutCopyMode = False
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")

With sum_cell
.Formula = "=sum(" & .Offset(-1,
0).Address & ":" &
..Offset(-copy_range.Rows.Count, 0).Address & ")"
.NumberFormat = """Total""_(* #,##0_);_
(*
(#,##0);_(*
""-""??_);_(@_)"
.Offset(0, -2) = "Acct "
.Offset(0, -1) = .Offset(-1, -1)
With Range(.Offset(0, -
2).Address, .Offset
(0,
0).Address)
.Font.Bold = True
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
End With
End With
End With
Set copy_range = Worksheets("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel < 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

Worksheets("Sheet2").Range("A1").Select

error:
Application.ScreenUpdating = True

End Sub

hth,

Doug


wrote in
message
...
Doug,
Thank you very much. It works!!!!!!!!! Is there
any
way
to modify the code to format the total balance
lines
(on
sheet2)like this: Acct 1111 Total 150 (in bold
surrounded
by top and bottom border lines)?
-----Original Message-----
Nat,

I modified a line in the last copy section and it
seems
to work. Also, I
wrote another routine for you. It's the first
one
below. You can run it
from sheet1 or sheet2 or elsewhere in the
workbook:

Sub Accounts2()

Dim rw, copy_range, sum_cell, cel As Range
Dim group_count, row_count, i As Integer
Dim delete_next As Boolean

Set copy_range = Worksheets("Sheet1").Rows
(2).EntireRow
For Each rw In Worksheets("Sheet1").Range("B2",
Worksheets("Sheet1").Cells(Worksheets
("Sheet1").Rows.Count, 2).End(xlUp))
If Worksheets("Sheet1").Cells(rw.Row, "B") =
Worksheets("Sheet1").Cells(rw.Row + 1, "B") Then
Set copy_range =
Worksheets("Sheet1").Range(copy_range.Resize
(copy_range.Rows.Count + 1,
1).EntireRow.Address)
Else
group_count = group_count + 1
copy_range.Copy Destination:=Worksheets
("Sheet2").Cells(rw.Row - 1 +
group_count - copy_range.Rows.Count, 1)
Set sum_cell = Worksheets("Sheet2").Cells
(rw.Row -
1 + group_count,
"C")
sum_cell.Formula = "=sum(" &
sum_cell.Offset
(-
1,
0).Address & ":" &
sum_cell.Offset(-copy_range.Rows.Count,
0).Address
& ")"
sum_cell.Font.Bold = True
Set copy_range = Worksheets
("Sheet1").Range
(Rows
(rw.Row +
1).EntireRow.Address)
End If
row_count = rw.Row - 1 + group_count
Next rw

delete_next = False
For i = row_count To 1 Step -1
Set cel = Worksheets("Sheet2").Cells(i, 3)
If cel.HasFormula Then
If cel <= 50 Then
delete_next = True
cel.EntireRow.Delete
Else
delete_next = False
End If
ElseIf delete_next = True Then
cel.EntireRow.Delete
End If
Next i

End Sub


Here's the modified original code:

Sub Accounts()
Dim i As Long, iRow As Long
Dim iStart As Long, iEnd As Long
Dim cLastRow As Long
Dim nACcount As Long, nBalance As Long
Dim fFirst As Boolean
Dim sRows As String

cLastRow = Cells(Rows.Count, "A").End
(xlUp).Row
nACcount = Range("B2").Value
nBalance = 0
iRow = 1
iStart = 2: iEnd = iStart
fFirst = True
For i = 2 To cLastRow
If Cells(i, "B").Value = nACcount Then
iEnd = iEnd + 1
nBalance = nBalance + Cells
(i, "C").Value
Else
nACcount = Cells(i, "B").Value
If nBalance 50 Then
Rows(iStart & ":" & iEnd -
1).Copy _
Destination:=Worksheets
("Sheet2").Cells(iRow, "A")
iRow = iRow + iEnd - iStart
With Worksheets("Sheet2").Cells
(iRow, "C")
.Value = nBalance
.Font.Bold = True
End With
iRow = iRow + 1
End If
nBalance = 0
iStart = iEnd
i = i - 1
End If
Next i

If nBalance 50 Then
Rows(iStart & ":" & iEnd - 1).Copy _
Destination:=Worksheets
("Sheet2").Cells
(iRow, "A")
With Worksheets("Sheet2").Cells(iRow +
iEnd -
iStart, "C")
.Value = nBalance
.Font.Bold = True
End With
End If

End Sub

hth,

Doug


"nat"
wrote in
message
...
Thank you Doug.
The continuation character fixed the syntax
error;
however, when I've tried to run it on my test
table,
the
total on sheet2 for the las account "3333" is
correct
(=210) but only one row (with $200 balance)
shows
up.
Any
idea why the row with $10 balance is not
showing?
Can
you
correct the code? Thank you in advance.


.



.



.



.

Nat,

Your welcome. It's been fun.

Doug

"Nat" wrote in message
...
Doug,
It WORKS!!!!!!!!!!!!!! Thank you and happy holidays!
-----Original Message-----