applying a filter and copying data to a new worksheet

[geordz]

Dear all,
Looking for some help. I have seen some similar examples on the net, but not exactly what i'm after. I have a worksheet (lets say 'data'). I have created a number of sheets t1 to t10 (these correspond to machines related to the StationId column in the datarange of worksheet 'data')

<TABLE style="WIDTH: 207pt; BORDER-COLLAPSE: collapse" cellSpacing=0 cellPadding=0 width=276 border=0><COLGROUP><COL style="WIDTH: 48pt" width=64><COL style="WIDTH: 63pt; mso-width-source: userset; mso-width-alt: 3072" width=84><COL style="WIDTH: 48pt" span=2 width=64><TBODY><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" width=64 height=17>station id</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 63pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=84>time stamp</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=64>WS</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; WIDTH: 48pt; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" width=64>WS sd</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" align=right height=17>23456</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/02/2009</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>4.58</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>0.88</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" align=right height=17>26789</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>01/02/2009</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>5.67</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>0.78</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" align=right height=17>13335</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>03/02/2009</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>7.89</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>0.99</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" align=right height=17>23456</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>02/02/2009</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>5.67</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>0.67</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" align=right height=17>23456</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>04/02/2009</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>7.89</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>0.77</TD></TR><TR style="HEIGHT: 12.75pt" height=17><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; HEIGHT: 12.75pt; BACKGROUND-COLOR: transparent" align=right height=17>26789</TD><TD class=xl63 style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>05/02/2009</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>3.34</TD><TD style="BORDER-RIGHT: #ece9d8; BORDER-TOP: #ece9d8; BORDER-LEFT: #ece9d8; BORDER-BOTTOM: #ece9d8; BACKGROUND-COLOR: transparent" align=right>0.45</TD></TR></TBODY></TABLE>

I wish to run a macro in each new worksheet, which looks up the criteria in that worksheet and then filters the data in 'data' and copies it to the worksheet. I have put the criteria (StationId) in each worksheet. The code I found is having a problem addressing the last row. There are 65563 rows in the 'data'

Sub TI_filter()
Dim MaxResults As Integer, MyCol As Integer, ResultsRng As String
Dim MyRow As Integer, LastDataRow As Integer, DataRng As String
Dim CritRow As Integer, CritRng As String, RightCol As Integer
Dim TopRow As Integer, BottomRow As Integer, LeftCol As Integer

' the source data MUST be in a worksheet called 'Data'
' *** MODIFY AND SET YOUR OWN RANGES ON THE FOLLOWING DECLARATIONS ***
' cell Data!E2 contains the last row number of data [=COUNT(E4:E100)+3]
LastDataRow = Worksheets("data").Range("D1").Value
DataRng = "A2:D2" ' range of column headers for Data table
CritRng = "A1:A2" ' range of cells for Criteria table
ResultsRng = "A5:D5" ' range of headers for Results table
MaxResults = 1000 ' any value higher than the number of possible results
' **************** END OF DECLARATIONS *********************
' fix the data range to incorporate the last row
TopRow = Range(DataRng).Row
LeftCol = Range(DataRng).Column
RightCol = LeftCol + Range(DataRng).Columns.Count - 1
DataRng = Range(Cells(TopRow, LeftCol), Cells(LastDataRow, RightCol)).Address
' fix the results range to incorporate the last row
TopRow = Range(ResultsRng).Row
LeftCol = Range(ResultsRng).Column
RightCol = LeftCol + Range(ResultsRng).Columns.Count - 1
ResultsRng = Range(Cells(TopRow + 1, LeftCol), Cells(MaxResults, RightCol)).Address
Range(ResultsRng).ClearContents ' clear any previous results but not headers
ResultsRng = Range(Cells(TopRow, LeftCol), Cells(MaxResults, RightCol)).Address
' fix the criteria range and identify the last row containing any items
TopRow = Range(CritRng).Row
BottomRow = TopRow + Range(CritRng).Rows.Count - 1
LeftCol = Range(CritRng).Column
RightCol = LeftCol + Range(CritRng).Columns.Count - 1
CritRow = 0
For MyRow = TopRow + 1 To BottomRow
For MyCol = LeftCol To RightCol
If Cells(MyRow, MyCol).Value <> "" Then CritRow = MyRow
Next
Next
If CritRow = 0 Then
MsgBox "No Criteria detected", "MeadInKent"
Else
CritRng = Range(Cells(TopRow, LeftCol), Cells(CritRow, RightCol)).Address
Debug.Print "DataRng, CritRng, ResultsRng: ", DataRng, CritRng, ResultsRng
Worksheets("Data").Range(DataRng).AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range(CritRng), CopyToRange:=Range(ResultsRng), _
Unique:=False
End If
Range("A2").Select
End Sub

Can somone help with some simpler code that does not use this method of specifying the last row as =count(A2:A65563), then calling it in the macro please, as I think thats what is causing the problem

hope this makes sense

cheers in advance fo any help

 

[geordz]

apologies, i did not see the wood for the trees, thought it was more complicated, but simply recording the advanced filter and making a button did the trick, as it uses the criteria in the local sheet.

no doubt i'll be back soon for more help being a newbie to VBA