Need code - new user
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.
.
|