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