ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   using filter based on last column (https://www.excelbanter.com/excel-programming/434336-re-using-filter-based-last-column.html)

Per Jessen[_2_]
using filter based on last column
 
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

scott
using filter based on last column
 
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" 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

Per Jessen[_2_]
using filter based on last column
 
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 -

scott
using filter based on last column
 
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

"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 -

scott
using filter based on last column
 
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 -

Per Jessen
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 -


All times are GMT +1. The time now is 12:46 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com