View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Per Jessen Per Jessen is offline
external usenet poster
 
Posts: 1,533
Default using filter based on last column

Glad you solved the first isssue yourself.

We need to add a sheet reference for each range/cells object, for the code
to work when FromWks is not activated.

Replace the 'error line' with the lines below and note the leading dots.

With FromWks
.Range(.Cells(14, LastCol - 7), .Cells(LastRow, LastCol)).AutoFilter
Field:=1
End With

Regards,
Per

"Scott" skrev i meddelelsen
...
Okay I got the filter bug fixed and it now copies but if I am in the Towks
listed in the program then it errors with Method 'Range' of
object'_Worksheet' failed. The debug line is
FromWks.Range(Cells(14, LastCol - 7), Cells(LastRow, LastCol)).AutoFilter
Field:=1
from the code below..


Sub CADFixtureTable()
Dim FromWks As Worksheet
Dim ToWks As Worksheet
Dim RngToFilter As Range
Dim RngToCopy As Range
Dim LastCol As Long

Set FromWks = Worksheets("fixture counts")
Set ToWks = Worksheets("CAD Fixture Schedule")

ToWks.Range("A3:F500").ClearContents

With FromWks
.AutoFilterMode = False
LastCol = .Cells(12, Columns.Count).End(xlToLeft).Column
Set RngToFilter = .Range(.Cells(14, LastCol - 3), .Cells(.Rows.Count,
LastCol - 3).End(xlUp))
RngToFilter.AutoFilter Field:=1, Criteria1:="<"

If .AutoFilter.Range.Columns(1).Cells.SpecialCells(xl CellTypeVisible) _
.Cells.Count = 1 Then

Else
With RngToFilter
Set RngToCopy = .Resize(.Rows.Count - 1, 6).Offset(1, -1)
End With
RngToCopy.Copy
ToWks.Range("a3").PasteSpecial Paste:=xlPasteValues
LastRow = FromWks.Cells(Rows.Count, LastCol).End(xlUp).Row


FromWks.Range(Cells(14, LastCol - 7), Cells(LastRow,
LastCol)).AutoFilter Field:=1


End If
End With
End Sub




"Per Jessen" wrote:

Hi

What is the error message you get, which line is highlighted when you
hit Debug?

To filter on the last 7 columns replace the line mentioned with the
lines below:

LastRow = FromWks.Cells(Rows.Count, LastCol).End(xlUp).Row
FromWks.Range(Cells(14, LastCol - 7), Cells(LastRow,
LastCol)).AutoFilter Field:=1

Hopes this helps.
....
Per

On 30 Sep., 20:24, Scott wrote:
I am getting an error. I think this has to do with the line that
reads:
Sheets("Fixture Counts").Range("$AF$14:$AF$91").AutoFilter Field:=1
...... I
need to copy from the last column found back 7 columns down to last
data in
rows within



"PerJessen" wrote:
Hi

Look at this. I only changed it for FromWks.

Sub CADFixtureTable()
Dim FromWks As Worksheet
Dim ToWks As Worksheet
Dim RngToFilter As Range
Dim RngToCopy As Range
Dim LastCol As Long

Set FromWks = Worksheets("fixture counts")
Set ToWks = Worksheets("CAD Fixture Schedule")

ToWks.Range("A3:F500").ClearContents

With FromWks
.AutoFilterMode = False
LastCol = .Cells(14, Columns.Count).End(xlToLeft).Column
Set RngToFilter = .Range(.Cells(LastCol - 4), .Cells(.Rows.Count,
LastCol - 4).End(xlUp))
RngToFilter.AutoFilter Field:=1, Criteria1:="<"

If .AutoFilter.Range.Columns(1).Cells.SpecialCells
(xlCellTypeVisible) _
.Cells.Count = 1 Then

Else
With RngToFilter
Set RngToCopy = .Resize(.Rows.Count - 1, 6).Offset(1, -1)
End With
RngToCopy.Copy
ToWks.Range("a3").PasteSpecial Paste:=xlPasteValues
Sheets("Fixture Counts").Range("$AF$14:$AF$91").AutoFilter
Field:=1
'ToWks.Select
End If
End With
End Sub

Regards,
Per

On 30 Sep., 16:22, Scott wrote:
I currently have the code below which only looks at AF:14 to filter
data. I
would like to add/delete data... so I need the code to find the
last column
with data and filter 4 cells left of that. EX.. Currently AJ has
last data
so needs to read AF:14 but if add 2 columns need to look at AM and
filter
AH:14

Sub CADFixtureTable()

Dim FromWks As Worksheet
Dim ToWks As Worksheet
Dim RngToFilter As Range
Dim RngToCopy As Range

Set FromWks = Worksheets("fixture counts")
Set ToWks = Worksheets("CAD Fixture Schedule")

ToWks.Select
Range("A3:F500").Select
Selection.ClearContents

With FromWks
.AutoFilterMode = False

Set RngToFilter = .Range("AF14", .Cells(.Rows.Count,
"AF").End(xlUp))
RngToFilter.AutoFilter Field:=1, Criteria1:="<"

If
.AutoFilter.Range.Columns(1).Cells.SpecialCells(xl CellTypeVisible)
_
.Cells.Count = 1 Then

Else
With RngToFilter

Set RngToCopy = .Resize(.Rows.Count - 1,
6).Offset(1, -1)
End With

RngToCopy.Copy
ToWks.Range("a3").PasteSpecial Paste:=xlPasteValues

Sheets("Fixture Counts").Select
ActiveSheet.Range("$AF$14:$AF$91").AutoFilter Field:=1

ToWks.Select
End If
End With

End Sub- Skjul tekst i anførselstegn -

- Vis tekst i anførselstegn -