filtering problem, wrong rows removed

[rinser]

Hi All,

I have a module that imports data from a text file (120000 rows), filters and removes some unneeded (85000)rows and then puts the data in a designated workbook.
Problem: when filtering by some criteria it for some reason removes a row off the final file for each criteria. I have a total of 23 filtering criteria. I have attached a file for exemplification. You can run the module and import the file, it will be without first 23 rows, even if non of the deleted rows contained the filter criteria.
example.txt

Sub ImportData()
' First it imports the file
    Dim ResultStr As String
    Dim FileName As String
    Dim FileNum As Integer
    Dim Counter As Double
     'Ask User for File's  Name
    FileName = Application.GetOpenFilename
     'Check for no entry
    If FileName = "" Then End
     'Get Next Available File Handle Number
    FileNum = FreeFile()
     'Open Text File For Input
    Open FileName For Input As #FileNum
     'Turn Screen Updating Off
    Application.ScreenUpdating = False
     'Create A New WorkBook With One  Worksheet In It
    Workbooks.Add Template:=xlWorksheet
     'Set The Counter to 1
    Counter = 1
     ' Loop Until the End Of File Is Reached
    Do While Seek(FileNum) <= LOF(FileNum)
         'Display  Importing Row Number On Status Bar
        Application.StatusBar = "Importing Row " & Counter & " of text file " _
        & FileName
         'Store One Line Of Text From File To  Variable
        Line Input #FileNum, ResultStr
         'Store Variable Data Into Active Cell
        If Left(ResultStr, 1) = "=" Then
            ActiveCell.Value = "'" & ResultStr
        Else
            ActiveCell.Value = ResultStr
        End If
        If ActiveCell.Row = 65536 Then
             'If On The Last Row Then Add A New Sheet
             ActiveWorkbook.Sheets.Add
        Else
             'If Not The Last Row Then Go One Cell Down
            ActiveCell.Offset(1, 0).Select
        End If
         'Increment the Counter By 1
        Counter = Counter + 1
         'Start Again At Top Of 'Do While' Statement
    Loop
     'Close The Open Text File
    Close
     'Remove Message From Status Bar
    Application.StatusBar = False
    
Columns("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2)), TrailingMinusNumbers:= _
        True

' Then the filtering follows
Dim rng As Range
Dim calcmode As Long
Dim myArr As Variant
Dim I As Long

    With Application
        calcmode = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    'The values for the filter (the 23 criteria, it deletes a row for each even if it shouldn't)
    myArr = Array("01*", "02*", "04*", "0999*", "10*", "110*", "111*", "112*", "113*", "114*", "115*", "12*", "13*", "14*", "15*", "16*", "17*", "18*", "19*", "5*", "6*", "8*", "9*")

    For I = LBound(myArr) To UBound(myArr)

        'Sheet with the data, you can also use Sheets("MySheet")
        With ActiveSheet

            'Firstly, remove the AutoFilter
            .AutoFilterMode = False

            'Apply the filter
            .Range("A1:A" & .Rows.Count).AutoFilter Field:=1, Criteria1:=myArr(I)

            Set rng = Nothing
            With .AutoFilter.Range
                On Error Resume Next
                Set rng = .Offset(0, 0).Resize(.Rows.Count - 1, 1) _
                          .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rng Is Nothing Then rng.EntireRow.Delete
            End With

            'Remove the AutoFilter
            .AutoFilterMode = False
        End With

    Next I

    With Application
        
        .Calculation = calcmode
    End With
' Then some copying of final data follows
    Range("A:A,C:C").Select
    Range("C1").Activate
    Selection.Copy
    Windows("Audit Tool.xls").Activate
    Sheets("Sheet1").Activate
    Range("A1").Select
    ActiveSheet.Paste
    
        
    Dim Lastrow As Long
    Lastrow = Range("A" & Rows.Count).End(xlUp).Row
    Sheets("Sheet2").Columns("A:B").ClearContents
    Range("A1:A" & Lastrow).Copy Sheets("Sheet2").Range("A3")
    Range("B1:B" & Lastrow).Copy Sheets("Sheet2").Range("B3")
    Sheets("Sheet2").Activate
    Range("A1").Select
    
End Sub

Please look into the code and help me figure out what is wrong with it.
Any ideas appreciated.

[rwgrietveld]

Taking just this bit of code

            With .AutoFilter.Range
                On Error Resume Next
                Set rng = .Offset(0, 0).Resize(.Rows.Count - 1, 1) _
                          .SpecialCells(xlCellTypeVisible)
                On Error GoTo 0
                If Not rng Is Nothing Then rng.EntireRow.Delete
            End With

So what you code does is: it removes all the rows that meat the 23 criteria (exept the last row) including the column header. I think deleting the header is not OK. maybe this should be offset(1,0) instead of offset(0,0)

[rinser]

Hi rwgrietveld,

I tried the offset (1,0) but no luck so far. I don't know if there is the problem with the header as the data begins at row 1.

Cheers.

[shg]

AutoFilter assumes that you have a header row. You need to add one.

[rinser]

I am adding a header row but it's not working so far. Probably I am adding it in the wrong place in the code sequence.

[royUK]

Your post does not comply with Rule 1 of our Forum RULES. Your post title should accurately and concisely describe your problem, not your anticipated solution. Use terms appropriate to a Google search. Poor thread titles, like Please Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will be addressed according to the OP's experience in the forum: If you have less than 10 posts, expect (and respond to) a request to change your thread title. If you have 10 or more posts, expect your post to be locked, so you can start a new thread with an appropriate title.
To change a Title on your post, click EDIT then Go Advanced and change your title, if 2 days have passed ask a moderator to do it for you.

Do not use unnecessary words like VBA in your thread titles.

[rinser]

Thank you. Noted.

[royUK]

To best describe or illustrate your problem you would be better off attaching a dummy workbook, the workbook should contain the same structure and some dummy data of the same type as the type you have in your real workbook - so, if a cell contains numbers & letters in this format abc-123 then that should be reflected in the dummy workbook.

If needed supply a before and after sheet in the workbook so the person helping you can see what you are trying to achieve.

Doing this will ensure you get the result you need!

[rinser]

Hi guys,
Sorry if I am extending the topic, thought it would be quicker this way since the code is already present in my first post.

Update: my modules are working quite fine after some fiddling except for one thing: given the number of rows (>105,000) it imports the entries on two worksheets. After the filtering is done the first row from the second worksheet, mainly row number 65537 is kept even if it shouldn't be according to filtering criteria. I think it is because of the offset(1,0) command, it does what I want on the first worksheet, but on the second it keeps the first row out of filter and it stays in the final table of results (about 20,000). Please let me know if you understand my explanation so far and what you think. Unfortunately I cannot attach a file as it would be nightmare to produce at least 67,000 rows of dummy data.
Cheers.

[shg]

First, you have to work within AutoFilter's limitations; see http://support.microsoft.com/kb/295971 and http://excel.tips.net/Pages/T002403_...own_Limit.html. You may need to break the data up into sections much smaller than 64K rows per sheet.

Second, every sheet needs a header row.

[rinser]

I seem to not be affected by the 1000 limitation.

Does anyone know how can I insert in my code the header row for the second worksheet?

Cheers.

[rinser]

Hi guys,

After some testing and checking the solution proposed by rwgrietveld worked. It seems it was the wrong offsetting that was the cause.

Thank you all for the help and support!