I have data on sheet "run Number"
I have tried to write code to delete rows containing 995915 and 995925 in Col G , but code takes a long time to run
There is +- 25000 rows of data
It would be appreciated if someone could amend my code so that it runs faster
Sub Delete_995915_995925_Run_number()
Dim ws As Worksheet
Dim lastRow As Long
Dim deleteRows() As Long
Dim deleteCount As Long
Dim i As Long
' Set the worksheet object
Set ws = ThisWorkbook.Sheets("Run Number")
' Find the last row with data in column G
lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
' Loop through the rows from row 2 onwards
For i = 2 To lastRow
' Check if the value in column G matches 995915 or 995925
If ws.Cells(i, "G").Value = 995915 Or ws.Cells(i, "G").Value = 995925 Then
' Store the row number in the deleteRows array
deleteCount = deleteCount + 1
ReDim Preserve deleteRows(1 To deleteCount)
deleteRows(deleteCount) = i
End If
Next i
' Delete the rows in one go
If deleteCount > 0 Then
For i = deleteCount To 1 Step -1
ws.Rows(deleteRows(i)).Delete
Next i
End If
End Sub [
I have tried to write code to delete rows containing 995915 and 995925 in Col G , but code takes a long time to run
There is +- 25000 rows of data
It would be appreciated if someone could amend my code so that it runs faster
Sub Delete_995915_995925_Run_number()
Dim ws As Worksheet
Dim lastRow As Long
Dim deleteRows() As Long
Dim deleteCount As Long
Dim i As Long
' Set the worksheet object
Set ws = ThisWorkbook.Sheets("Run Number")
' Find the last row with data in column G
lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
' Loop through the rows from row 2 onwards
For i = 2 To lastRow
' Check if the value in column G matches 995915 or 995925
If ws.Cells(i, "G").Value = 995915 Or ws.Cells(i, "G").Value = 995925 Then
' Store the row number in the deleteRows array
deleteCount = deleteCount + 1
ReDim Preserve deleteRows(1 To deleteCount)
deleteRows(deleteCount) = i
End If
Next i
' Delete the rows in one go
If deleteCount > 0 Then
For i = deleteCount To 1 Step -1
ws.Rows(deleteRows(i)).Delete
Next i
End If
End Sub [