using filter based on last column

[Scott]

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(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").Select
ActiveSheet.Range("$AF$14:$AF$91").AutoFilter Field:=1

ToWks.Select
End If
End With

End Sub

 

[Per Jessen]

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

 

[Scott]

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

 

[Per Jessen]

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

 

[Scott]

The line is RngToCopy.Copy I think it is trying to copy above row 14 because
I have merged cells above that. Also the code does run but the error comes
up. When it runs up to that it is filtering the wrong cells it is filtering
the 4th from last but it is starting at row 1 not 14 as it should

Thanks for all the help

 

[Scott]

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(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
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]

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