Hello Fellow community members!
This is a query related to VBA code optimisation and I am a beginner so I do not have much experience in this area. I am currently working on an excel file for building a dashboard and it required cleaning the data in the spreadsheet. So I wrote a very simple VBA code that successfully works but it takes an unusual amount of time to execute (40-45 mins). I researched on the internet regarding this but couldnt find a solution. I would be very happy if someone could help me with optimising the VBA code that I have created (posted below) so that it takes hopefully a maximum of 5 or 10 mins to execute or even faster. The code is simple where it deletes the entire row if the given criteria is matched in the specified range in a column. Thank you in advance for your help and I will be very grateful as I am a student working on this project!
VBA Code:
This is a query related to VBA code optimisation and I am a beginner so I do not have much experience in this area. I am currently working on an excel file for building a dashboard and it required cleaning the data in the spreadsheet. So I wrote a very simple VBA code that successfully works but it takes an unusual amount of time to execute (40-45 mins). I researched on the internet regarding this but couldnt find a solution. I would be very happy if someone could help me with optimising the VBA code that I have created (posted below) so that it takes hopefully a maximum of 5 or 10 mins to execute or even faster. The code is simple where it deletes the entire row if the given criteria is matched in the specified range in a column. Thank you in advance for your help and I will be very grateful as I am a student working on this project!
VBA Code:
VBA Code:
Sub Dashboard()
Application.ScreenUpdating = False
Dim rng As Range, i As Integer
'Set range to evaluate
Set rng = Range("N8:N10000")
'Loop backwards through the rows in the range to evaluate
For i = rng.Rows.Count To 1 Step -1
'If cell i in the range contains "x", delete the entire row
If rng.Cells(i).Value = "John" Then rng.Cells(i).EntireRow.Delete
Next
'Delete name Tom
Set rng = Range("L8:L10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "TOM" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("L8:L10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("O8:O10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("Q8:Q10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Sara
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "SARA" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Ben
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "BEN" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Meredith
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "MEREDITH" Then rng.Cells(i).EntireRow.Delete
Next
'Delete April
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "APRIL" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Jason
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "JASON" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Sana
Set rng = Range("R8:R10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "SANA" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
'Delete June
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "JUNE" Then rng.Cells(i).EntireRow.Delete
Next
'Delete October
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "OCTOBER" Then rng.Cells(i).EntireRow.Delete
Next
'Delete January
Set rng = Range("AJ8:AJ10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "JANUARY" Then rng.Cells(i).EntireRow.Delete
Next
'Delete Blanks
Set rng = Range("AS8:AS10000")
For i = rng.Rows.Count To 1 Step -1
If rng.Cells(i).Value = "" Then rng.Cells(i).EntireRow.Delete
Next
Application.ScreenUpdating = True
End Sub
Last edited by a moderator: