Slow running macro

[wikus]

The macro reads a csv file and delete all rows containing "2023".
My files have 200 000 plus rows.
Can anyone suggest a way to make it faster.
Any help will be appreciated.

Sub DeleteRowsContaining2023()
    Dim filePath As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim csvData As String
    Dim lines() As String
    Dim filteredLines As String
    Dim i As Long
    Dim j As Long
    
    ' Prompt user to select the CSV file
    filePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
    If filePath = "False" Then
        MsgBox "No file selected. Exiting macro."
        Exit Sub
    End If
    
    ' Read CSV file content into a string
   
 Open filePath For Input As #1
    csvData = Input$(LOF(1), 1)
    Close #1
    
    ' Split the CSV data into lines
    lines = Split(csvData, vbCrLf)
    
    ' Loop through each line and filter out lines containing "2023"
    For i = LBound(lines) To UBound(lines)
        If InStr(1, lines(i), "2023") = 0 Then
            filteredLines = filteredLines & lines(i) & vbCrLf
        End If
    Next i
    
    ' Write the filtered data back to the CSV file
    Open filePath For Output As #1
    Print #1, Left(filteredLines, Len(filteredLines) - 1)
    Close #1
    
    MsgBox "Rows containing '2023' have been deleted from the CSV file.", vbInformation
End Sub

 

[Fuji]

How about?

Sub DeleteRowsContaining2023()
    Dim filePath As String
    Dim csvData As String
    Dim lines() As String
    Dim n&
    
    ' Prompt user to select the CSV file
    filePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
    If filePath = "False" Then
        MsgBox "No file selected. Exiting macro."
        Exit Sub
    End If
    ReDim lines(1 To 50000)
    Open filePath For Input As #2
        Do Until EOF(2)
            Line Input #2, csvData
            If csvData Like "*2023*" Then
                n = n + 1
                If n > UBound(lines) Then ReDim Preserve lines(1 To UBound(lines) + 50000)
                lines(n) = csvData
            End If
        Loop
    Close #2
    If n = 0 Then MsgBox "No '2023' data found.": Exit Sub
    Open filePath For Output As #1
        Print #1, Join(lines, vbCrLf);
    Close #1
    MsgBox "Rows containing '2023' have been deleted from the CSV file.", vbInformation
End Sub

 

[Fuji]

Line Input takes time for large file...

Sub DeleteRowsContaining2023()
    Dim filePath As String
    Dim csvData As String
    Dim lines() As String
    Dim n&, e, myCR
   
    myCR = vbCrLf '<--- change here to actual line feeder
   
    filePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
    If filePath = "False" Then
        MsgBox "No file selected. Exiting macro."
        Exit Sub
    End If
    ReDim lines(1 To 50000)
    csvData = CreateObject("Scripting.FileSystemObject").OpenTextFile(filePath).ReadAll
    For Each e In Split(csvData, myCR)
        If InStr(e, "2023") Then
            n = n + 1
            If n > UBound(lines) Then ReDim Preserve lines(1 To UBound(lines) + 50000)
            lines(n) = e
        End If
    Next
    If n = 0 Then MsgBox "No '2023' data found.": Exit Sub
    Open filePath For Output As #1
        Print #1, Join(lines, myCR);
    Close #1
    MsgBox "Rows containing '2023' have been deleted from the CSV file.", vbInformation
End Sub

 

[Fuji]

One line missed above.

    If n = 0 Then MsgBox "No '2023' data found.": Exit Sub
    ReDim Preserve lines(1 To n)   '<---- this line
    Open filePath For Output As #1

 

[wikus]

The macro reads a csv file and delete all rows containing "2023".
My files have 200 000 plus rows.
Can anyone suggest a way to make it faster.
Any help will be appreciated.

Sub DeleteRowsContaining2023()
    Dim filePath As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim csvData As String
    Dim lines() As String
    Dim filteredLines As String
    Dim i As Long
    Dim j As Long
   
    ' Prompt user to select the CSV file
    filePath = Application.GetOpenFilename("CSV Files (*.csv), *.csv")
    If filePath = "False" Then
        MsgBox "No file selected. Exiting macro."
        Exit Sub
    End If
   
    ' Read CSV file content into a string
  
 Open filePath For Input As #1
    csvData = Input$(LOF(1), 1)
    Close #1
   
    ' Split the CSV data into lines
    lines = Split(csvData, vbCrLf)
   
    ' Loop through each line and filter out lines containing "2023"
    For i = LBound(lines) To UBound(lines)
        If InStr(1, lines(i), "2023") = 0 Then
            filteredLines = filteredLines & lines(i) & vbCrLf
        End If
    Next i
   
    ' Write the filtered data back to the CSV file
    Open filePath For Output As #1
    Print #1, Left(filteredLines, Len(filteredLines) - 1)
    Close #1
   
    MsgBox "Rows containing '2023' have been deleted from the CSV file.", vbInformation
End Sub

Thank you very much for the reply, I will give it a try.