Creating a total line

[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.

 

[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

 

[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)

 

[Mike Fogleman]

Tom forgot the SUM function in that last line:

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

Mike F

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

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.

 

[Tom Ogilvy]

Thanks for the correction.

--
Regards,
Tom Ogilvy

Tom forgot the SUM function in that last line:

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

Mike F

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

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.