VBA Trying to filter and delete records in workbook of 1,000,000 records - need better solution

[Tesla]

Need VBA solution for identifying a specific string in Column E, and deleting all the other rows that don't have that string.

FYI - Using MS Access for Remote Automation of an Excel Workbook
The code below was designed to open the workbook with a CSV converted file of over 1,000,000 rows (2 to the 10th power)
The code ran for 15 minutes but only deleted around 10,000 rows. (works correct, but way, way too slow)
The data dumps of over 1,000,000 rows once filtered will end up with about 12,000 rows on average.
This is saved as, and used in the next business process.

Tried to record a macro. created a filter on Row A (header) then on Column E - Text Filter Does not contain "SENG"
Then highlighted all of the rows and deleted them. Turn off filter. Problem is that all of the empty rows still exist!

Public Sub OpenExcelWorkbookforAutomationFilterAndSave()
Dim Objxl As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim LR As Long
Dim CSVRawFileName As String
' this is hardcoded for testing - add as parameter later
CSVRawFileName = "C:\Users\UserName\ExcelTesting\CAPEX Transaction Details.xlsx"
Set Objxl = New Excel.Application
Set xlWB = Objxl.Workbooks.Open(CSVRawFileName) '<add user="" function="" Environ="" in="" PC
Set xlSh = xlWB.Sheets(1) '<csv 1="" has="" file="" worksheet
'Remote code
    Objxl.ScreenUpdating = False
    With xlSh
        For LR = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
            If Trim(Range("E" & LR).Value) <> "SENG" Then
                .Rows(LR).EntireRow.Delete
            Else
                Debug.Print "found " & Trim(Range("E" & LR).Value) ' Expect 12,000 rows of the over 1,000,000
            End If
    Next LR
    End With
    Objxl.ScreenUpdating = True

    xlWB.SaveAs FileName:= _
        "C:\Users\UserName\Desktop\ExcelTesting\CAPEX Transaction DetailCulled.xlsx" _
        , CreateBackup:=False
xlWB.Save
xlWB.Close
Objxl.Quit
Set Objxl = Nothing
End Sub

</csv></add>

 

[Tesla]

another try with the filter, this worked and left the correct amount of records starting below the header (no big group of row spaces).
All that is needed is: Once the filter leaves all the 1,000,000 rows that need deleted - how can the count be used for the visible rows (not filtered) to be highlighted and deleted?

Sub Macro3()
    Rows("1:1").Select
    Selection.AutoFilter
    ' Adjust to select entire data range minus header
    ActiveSheet.Range("$A$1:$CG$1047095").AutoFilter Field:=5, Criteria1:= _
        "<>EPSENG", Operator:=xlAnd
    Rows("2:2").Select
    Selection.Delete Shift:=xlUp
    ActiveSheet.Range("$A$1:$CG$12698").AutoFilter Field:=5
End Sub

 

[Tesla]

Code is not pretty, but works. Will condense it into a loop.
Takes large CSV file and small CSV file (exact same format) each saved into Excel.
Take CSV - filter on one column, delete all other rows that don't match, save as into another folder (leaving the original intact).
Now, take the two filtered output files, copy the 2nd smaller file's rows and append them to the 1st larger file.
The intent is then to delete the 2nd smaller file.

Public Sub OpenExcelWorkbookforAutomationFilterAndSave()
Dim CountFiles As Integer
Dim Objxl As Excel.Application
Dim xlWB As Excel.Workbook
Dim xlSh As Excel.Worksheet
Dim xlWB2 As Excel.Workbook     ' for copy paste later
Dim xlSh2 As Excel.Worksheet    ' for copy paste later


Dim lr As Long
Dim rng As Range
Dim CSVRawFileName As String
Dim LastRow As Long
Dim EPSENG_InputFile1 As String '   CSVRawFileName - typically over 1M rows (max for excel)
Dim EPSENG_InputFile2 As String '   CSVRawFileName2 - a few hundred thousand
Dim EPSENG_OutputFile As String '   The two files above are filtered, appended and sent here for the next process
Dim EPSENG_OutputFile2 As String '  The results of this file will be cut and copied to the EQSENG_Output file then this file will be deleted


Dim DropCsvFolder As String
DropCsvFolder = "C:\Users\Me\Desktop\NoProjExcel\DropCSV"
' ToDo this is hardcoded for testing - add as parameter later
On Error GoTo err_Trap
' Input File Folder
EPSENG_InputFile1 = "C:\Users\rmille008c\Desktop\NoProjExcel\DropCSV\CAPEX Transaction Details 1.xlsx"
EPSENG_InputFile2 = "C:\Users\Me\Desktop\NoProjExcel\DropCSV\CAPEX Transaction Details 2.xlsx"


' CSVRawFileName = "C:\Users\Me\Desktop\NoProjExcel\ExcelTesting\CAPEX Transaction Details 10.3.16.xlsx" ' Retired after test
' Output File Folder
EPSENG_OutputFile = "C:\Users\Me\Desktop\NoProjExcel\OutEPSENG\EPSENG CAPEX Transaction Detail.xlsx"
EPSENG_OutputFile2 = "C:\Users\Me\Desktop\NoProjExcel\OutEPSENG\EPSENG CAPEX Transaction Detail2.xlsx"


'Precheck - Validate there are 2 files in DropCSV folder
CountFiles = Count_Files(DropCsvFolder)  ' Expect 2 csv folders to begin
'If CountFiles <> 2 Then  ' a custom function not uploaded here to insure 2 files exist
'    MsgBox "Please look in " & DropCsvFolder & " folder - there should be 2 Excel files to process ", vbOKOnly, "Stop Process, Please start again"
'End If


' Create Objects
Set Objxl = New Excel.Application
Set xlWB = Objxl.Workbooks.Open(EPSENG_InputFile1) '<add in Environ function for user PC
Set xlSh = xlWB.Sheets(1) '<CSV file has 1 worksheet
' Process Data
    'Objxl.ScreenUpdating = False
    With Objxl
    LastRow = (.Cells(.Rows.Count, "A").End(xlUp).Row) - 1 ' works on small set failed over 1,000,000
        .Rows("1:1").Select
        'If .AutoFilterMode = True Then
        'Else
        '    .Selection.AutoFilter
        'End If
    ' Adjust to select entire data range minus header   - to do Set variable here to reuse for other filters Note 5th column has criteria
        .Range("E" & .Rows.Count).AutoFilter Field:=5, Criteria1:= _
        "<>EPSENG", Operator:=xlAnd
        LastRow = (.Rows.Count) ' - 1   ' comment out -1 the Last Record was not filtered correctly
        .Range("$A$2:Z" & LastRow).Select
        .Range("$A$2:Z" & LastRow).SpecialCells _
    (xlCellTypeVisible).EntireRow.Delete
        '.Rows("2:2").Select
        .ActiveSheet.Range("$A$1:$CG$" & LastRow).AutoFilter Field:=5
        .Rows("1:1").Select
        .Selection.AutoFilter ' turn off autofilter
    End With
    Objxl.ScreenUpdating = True
'Save to Output folders
    Objxl.DisplayAlerts = False ' if file save as already exist, automatically overwrite it
    xlWB.SaveAs filename:=EPSENG_OutputFile, CreateBackup:=False ' output to folder
xlWB.Save
' Cleanup Objects
xlWB.Close
Objxl.Quit
Set Objxl = Nothing  ' clean up then start over
' This concludes the large file filtered and saved to or saved over the  OutEpseng Folder.
' Since this application lifecycle is for a short term - the 2nd file will be a copy 
' The second excel (CSV file) is smaller -
' It will also be opened the same and processed - with this addition"
' The output file will evaluate the record size, select and cut the records, go to the first output file and append (paste)
' Then the 2nd output file will be deleted - this leaves one single output file
' Create Objects
' ---------------------------------- Input and output file2 - then merge the outputs and delete file 2 -----------
Set Objxl = New Excel.Application
Set xlWB2 = Objxl.Workbooks.Open(EPSENG_InputFile2) '<add in Environ function for user PC
Set xlSh2 = xlWB2.Sheets(1) '<CSV file has 1 worksheet
' Process Data
    'Objxl.ScreenUpdating = False
    With Objxl
    LastRow = (.Cells(.Rows.Count, "A").End(xlUp).Row) - 1 ' works on small set failed over 1,000,000
        .Rows("1:1").Select
        'If .AutoFilterMode = True Then
        'Else
        '    .Selection.AutoFilter
        'End If
    ' Adjust to select entire data range minus header   - to do Set variable here to reuse for other filters
        .Range("E" & .Rows.Count).AutoFilter Field:=5, Criteria1:= _
        "<>EPSENG", Operator:=xlAnd
        LastRow = (.Rows.Count) ' - 1   ' comment out -1 the Last Record was not filtered correctly
        .Range("$A$2:Z" & LastRow).Select
        .Range("$A$2:Z" & LastRow).SpecialCells _
        (xlCellTypeVisible).EntireRow.Delete
        '.Rows("2:2").Select
        .ActiveSheet.Range("$A$1:$CG$" & LastRow).AutoFilter Field:=5
        .Rows("1:1").Select
        .Selection.AutoFilter ' turn off autofilter
    End With
    Objxl.ScreenUpdating = True
'Save to Output folders
    Objxl.DisplayAlerts = False ' if file save as already exist, automatically overwrite it
    xlWB2.SaveAs filename:=EPSENG_OutputFile2, CreateBackup:=False ' output to folder
    xlWB2.Save


' *********************************************************
'   Transfer data from wb2 to wb1 - save wb1 - delete wb2 (this code didn't delete - will add it later)
' *********************************************************
' Dim lr As Long, rng As Range ' declare above leave for testing
' Open up first workbook to receive paste
Set xlWB = Objxl.Workbooks.Open(EPSENG_OutputFile) '<add in Environ function for user PC
Set xlSh = xlWB.Sheets(1) '<CSV file has 1 worksheet


Set xlWB2 = Objxl.Workbooks.Open(EPSENG_OutputFile2) '<already open - just re-Set it

Set xlSh2 = xlWB2.Sheets(1) '<CSV file has 1 worksheet


' Count Workbook2 worksheets records - copy and paste to bottom of Workbook 1 records.
lr = xlSh2.Cells(Rows.Count, 1).End(xlUp).Row  ' copy sheet 2 data
Set rng = xlSh2.Range("A2:A" & lr)
rng.EntireRow.Copy xlSh.Cells(xlSh2.Rows.Count, 1).End(xlUp)(2)
'End Sub
xlWB2.Save
xlWB.Save


' Cleanup Objects
xlWB.Close
xlWB2.Close
Objxl.Quit
Set Objxl = Nothing  ' either an object clean up or.. a put-down LOL




Exit Sub
' Error Handling
err_Trap:
    MsgBox "The following error has occured, please make a note: " & Err.Number & " " & Err.Description, _
            vbOKOnly, "OpenExcelWorkbookforAutomation"
On Error Resume Next
    xlWB.Close
    xlWB2.Close
    Objxl.Quit
    Set Objxl = Nothing  ' clean up then start over
End Sub