VBA Advanced filter ERROR 6 overflow

[ceslyn]

Hi,

Can anyone help me out on finding how to do an advanced filter up to 65536 lines.
I cannot filter pass 30000 or else i get an error 6 overflow.

Any help would be appreciated.

Thanks!

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 'List'
' *** 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("List").Range("E2").Value
LastDataRow = 35000
DataRng = "A6:K6" ' range of column headers for Data table
CritRng = "A4:K20" ' range of cells for Criteria table
ResultsRng = "A36:K36" ' range of headers for Results table
MaxResults = 30000 ' 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("List").Range(DataRng).AdvancedFilter ACTION:=xlFilterCopy, _
CriteriaRange:=Range(CritRng), CopyToRange:=Range(ResultsRng), _
Unique:=False
End If
Range("A5").Select

 

[VoG]

Hi. Replace Integer with Long

 

[ceslyn]

Hi. Replace Integer with Long

Just answered my question.

Thanks alot, all working fine now.