View Single Post
  #15   Report Post  
Posted to microsoft.public.excel.programming
Doug Glancy Doug Glancy is offline
external usenet poster
 
Posts: 770
Default Need code - new user

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.


.



.



.