Creating a total line

  • Thread starter jln via OfficeKB.com
  • Start date
J

jln via OfficeKB.com

Im trying to Have a total line that is created below the last line of data.
I never know how many records there are going to be each month here is the
code that i would like to intergrate it with.

Sub NetPIlIQ()

Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
With Worksheets("TOEPIEXP")
Set rng = Range("A1").CurrentRegion
rng.AutoFilter Field:=24, Criteria1:=">0"
Set rng2 = .AutoFilter.Range
Set rng2 = rng2.Offset(1, 0).Resize( _
rng2.Rows.Count - 1)
Set rng3 = .Range("B:B,E:E,V:V,X:X,AD:AD").EntireColumn
Set rng1 = Intersect(rng2.EntireRow, rng3)
End With
Set rng4 = Worksheets("NetPILIQ") _
..Cells(Rows.Count, 1).End(xlUp)(2)
If rng4.Row < 6 Then
Set rng4 = Worksheets("NetPILIQ").Range("A6")
rng1.Copy rng4
End If
Selection.AutoFilter 'removes autofilter
End Sub

Any help would be great.
 
T

Tom Ogilvy

Sub Copydata()
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 as Range
With Worksheets("NetPILIQ")
.Range("A7:IV65536").Clear
End With
With Worksheets("TOEPIEXP")
..AutoFilterMode = False
Set rng = .Range("A1").CurrentRegion
rng.AutoFilter Field:=24, Criteria1:=">0"
Set rng2 = .AutoFilter.Range
Set rng2 = rng2.Offset(1, 0).Resize( _
rng2.Rows.Count - 1)
Set rng3 = .Range("B:B,E:E,V:V,X:X,AD:AD").EntireColumn
Set rng1 = Intersect(rng2.EntireRow, rng3)
End With
Set rng4 = Worksheets("NetPILIQ") _
..Cells(Rows.Count, 1).End(xlUp)(2)
If rng4.Row < 6 Then
Set rng4 = Worksheets("NetPILIQ").Range("A6")
rng1.Copy rng4
End If
Worksheets("TOEPIEXP").AutoFilterMode = False
set rng5 =Worksheets("NetPILIQ").cells(rows.count,1).End(xlup)(2)
rng5.Resize(1,5).FormulaR1C1 = "=R6C:R[-1]C"
End Sub
 
B

Bob Phillips

This is how you can calculate the next free row

Set NextFree = Cells(Rows.Count, "B").End(xlUp).Offset(1,0)

couldn't work out where you would add it, or what to sum.


--
HTH

Bob Phillips

(replace somewhere in email address with gmail if mailing direct)
 
M

Mike Fogleman

Tom forgot the SUM function in that last line:

rng5.Resize(1, 5).FormulaR1C1 = "=Sum(R6C:R[-1]C)"

Mike F
Tom Ogilvy said:
Sub Copydata()
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 as Range
With Worksheets("NetPILIQ")
.Range("A7:IV65536").Clear
End With
With Worksheets("TOEPIEXP")
.AutoFilterMode = False
Set rng = .Range("A1").CurrentRegion
rng.AutoFilter Field:=24, Criteria1:=">0"
Set rng2 = .AutoFilter.Range
Set rng2 = rng2.Offset(1, 0).Resize( _
rng2.Rows.Count - 1)
Set rng3 = .Range("B:B,E:E,V:V,X:X,AD:AD").EntireColumn
Set rng1 = Intersect(rng2.EntireRow, rng3)
End With
Set rng4 = Worksheets("NetPILIQ") _
.Cells(Rows.Count, 1).End(xlUp)(2)
If rng4.Row < 6 Then
Set rng4 = Worksheets("NetPILIQ").Range("A6")
rng1.Copy rng4
End If
Worksheets("TOEPIEXP").AutoFilterMode = False
set rng5 =Worksheets("NetPILIQ").cells(rows.count,1).End(xlup)(2)
rng5.Resize(1,5).FormulaR1C1 = "=R6C:R[-1]C"
End Sub

--
Regards,
Tom Ogilvy


jln via OfficeKB.com said:
Im trying to Have a total line that is created below the last line of
data.
I never know how many records there are going to be each month here is
the
code that i would like to intergrate it with.

Sub NetPIlIQ()

Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
With Worksheets("TOEPIEXP")
Set rng = Range("A1").CurrentRegion
rng.AutoFilter Field:=24, Criteria1:=">0"
Set rng2 = .AutoFilter.Range
Set rng2 = rng2.Offset(1, 0).Resize( _
rng2.Rows.Count - 1)
Set rng3 = .Range("B:B,E:E,V:V,X:X,AD:AD").EntireColumn
Set rng1 = Intersect(rng2.EntireRow, rng3)
End With
Set rng4 = Worksheets("NetPILIQ") _
.Cells(Rows.Count, 1).End(xlUp)(2)
If rng4.Row < 6 Then
Set rng4 = Worksheets("NetPILIQ").Range("A6")
rng1.Copy rng4
End If
Selection.AutoFilter 'removes autofilter
End Sub

Any help would be great.
 
T

Tom Ogilvy

Thanks for the correction.

--
Regards,
Tom Ogilvy

Mike Fogleman said:
Tom forgot the SUM function in that last line:

rng5.Resize(1, 5).FormulaR1C1 = "=Sum(R6C:R[-1]C)"

Mike F
Tom Ogilvy said:
Sub Copydata()
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
Dim rng5 as Range
With Worksheets("NetPILIQ")
.Range("A7:IV65536").Clear
End With
With Worksheets("TOEPIEXP")
.AutoFilterMode = False
Set rng = .Range("A1").CurrentRegion
rng.AutoFilter Field:=24, Criteria1:=">0"
Set rng2 = .AutoFilter.Range
Set rng2 = rng2.Offset(1, 0).Resize( _
rng2.Rows.Count - 1)
Set rng3 = .Range("B:B,E:E,V:V,X:X,AD:AD").EntireColumn
Set rng1 = Intersect(rng2.EntireRow, rng3)
End With
Set rng4 = Worksheets("NetPILIQ") _
.Cells(Rows.Count, 1).End(xlUp)(2)
If rng4.Row < 6 Then
Set rng4 = Worksheets("NetPILIQ").Range("A6")
rng1.Copy rng4
End If
Worksheets("TOEPIEXP").AutoFilterMode = False
set rng5 =Worksheets("NetPILIQ").cells(rows.count,1).End(xlup)(2)
rng5.Resize(1,5).FormulaR1C1 = "=R6C:R[-1]C"
End Sub

--
Regards,
Tom Ogilvy


jln via OfficeKB.com said:
Im trying to Have a total line that is created below the last line of
data.
I never know how many records there are going to be each month here is
the
code that i would like to intergrate it with.

Sub NetPIlIQ()

Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim rng4 As Range
With Worksheets("TOEPIEXP")
Set rng = Range("A1").CurrentRegion
rng.AutoFilter Field:=24, Criteria1:=">0"
Set rng2 = .AutoFilter.Range
Set rng2 = rng2.Offset(1, 0).Resize( _
rng2.Rows.Count - 1)
Set rng3 = .Range("B:B,E:E,V:V,X:X,AD:AD").EntireColumn
Set rng1 = Intersect(rng2.EntireRow, rng3)
End With
Set rng4 = Worksheets("NetPILIQ") _
.Cells(Rows.Count, 1).End(xlUp)(2)
If rng4.Row < 6 Then
Set rng4 = Worksheets("NetPILIQ").Range("A6")
rng1.Copy rng4
End If
Selection.AutoFilter 'removes autofilter
End Sub

Any help would be great.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top