# Conditionally deleting rows in a worksheet

I have used loops to remove lines that are doing various things, but all are deleting rows where certain criteria is met. Some are deleting less than certain numbers, deleting blanks, removing specific rows that contain specific things in columns, remove all the items that don't contain 4 specific parts. This works but it is slow and I'm sure someone can do this in a better way. Can anyone give me any advice?

Sub DeleteRandom()

Worksheets(2).Select
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
ActiveSheet.DisplayPageBreaks = False
Dim r As Integer

'This part deletes out all the non essential items (basically like the filting does)

For r = Worksheets(2).UsedRange.Rows.Count To 1 Step -1
'Amount paid is more than 0
If Cells(r, "C") <= 0 Then
Worksheets(2).Rows(r).EntireRow.Delete
'Compound Code field is not blank
ElseIf Cells(r, "AE") = "" Then
Worksheets(2).Rows(r).EntireRow.Delete
'Compound Code is 0 or 1
ElseIf Cells(r, "AE") >= 2 Then
Worksheets(2).Rows(r).EntireRow.Delete
'Claim type is for paid claims only
ElseIf Cells(r, "L") <> "P" Then
Worksheets(2).Rows(r).EntireRow.Delete
'Next 3 items remove CICS Claim Status that include CAC, OVR, or PWE
ElseIf Cells(r, "J") = "CAC" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "J") = "OVR" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "J") = "PWE" Then
Worksheets(2).Rows(r).EntireRow.Delete
'Next 9 items remove Drug Category Codes D, I, M, N, O, P, Q, R, or S
ElseIf Cells(r, "S") = "D" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "I" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "M" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "N" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "O" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "P" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "Q" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "R" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "S") = "S" Then
Worksheets(2).Rows(r).EntireRow.Delete
'Keeps only the Preauth = 0 rows
ElseIf Cells(r, "N") <> 0 Then
Worksheets(2).Rows(r).EntireRow.Delete
'Next 8 remove Group IDs that are not DS, GM, HP, or LP
ElseIf Cells(r, "AD") = "940" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "AD") = "MMPDMBA" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "AD") = "MPXDMBA" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "AD") = "PRODMBA" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "AD") = "SCXFRGN" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "AD") = "SPHDMBA" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "AD") = "SPIDMBA" Then
Worksheets(2).Rows(r).EntireRow.Delete
ElseIf Cells(r, "AD") = "SPUDMBA" Then
Worksheets(2).Rows(r).EntireRow.Delete
End If
Next

'This part adds the headers
Worksheets(2).Select
Range("A1").EntireRow.Insert
Worksheets(1).Select
'This part is picking only the specific headers we need (skipping all the other headers)
Range("D1:E1,G1:G1,Q1:Q1,U1:Y1,AK1:AK1,AW1:AW1,BD1:BD1,BK1:BK1,BR1:BS1,BW1:BW1,BY1:CA1,CE1:CE1,CG1:CG1,CI1:CJ1,CL1:CM1,CO1:CP1,CX1:CY1,DD1:DD1,HY1:HY1,KT1:KT1,LI1:LI1,MV1:MW1,NM1:NM1,PL1:PL1,PX1:PX1,QF1:QF1").Copy
Worksheets(2).Select
Range("A1").Select
ActiveSheet.Paste
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
ActiveSheet.DisplayPageBreaks = True
End Sub

-
Use a bunch of Ors and make it one long If line. – Chrismas007 Mar 15 at 17:23
can you give an example (like just the "S" sections or something)? – MadChadders Mar 15 at 17:25
'If Blah OR Blah OR Blah OR Blah Then EntireRow.Delete – Chrismas007 Mar 15 at 17:27
So like: 'If Cells(r, "S") = "D" Or "I" Or "M" Or "N" Or "O" Or "P" Or "Q" Or "R" Or "S" Then Worksheets(2).Rows(r).EntireRow.Delete' how would this work with all those loops? – MadChadders Mar 15 at 17:30

## 2 Answers

You have fallen prey to a common temptation: writing a script. The problem with a script, is that it feels clunky and wrong, a bit like macro-recorder code does.

What is this code achieving?

Public Sub DeleteRandom()


Is it deleting random rows? Naming is hard. But it's worth it. Take the time to name things properly. Is it deleting non-essential rows? Then how about..

Public Sub DeleteNonEssentialRows()


So, back to the original question: what is this code achieving?

• Turn off screen updating (and set calculation mode to manual?), for performance
• Hide status bar and page breaks (for... what for?)
• Iterate rows in the used range of Sheet2...
• ...delete unwanted rows
• Copy headers to Sheet1
• Restore status bar and page breaks
• Restore screen updating

What's the copy headers to sheet1 doing there? Is that part of deleting non-essential rows? No! It's a completely separate concern, and one could argue it's an undesirable side-effect of calling the DeleteRandom procedure: if the calling code wants to copy headings to sheet1, let the calling code do it.

Make a procedure responsible for toggling screen updating, status bar and page breaks (and calculation mode?).. although I seriously question why you would want to hide the status bar at any time - this feels rather surprising, especially since you could instead be using it to convey some "Please wait..." message to the user so they know your code is running and Excel isn't frozen.

Make another procedure responsible for copying the headers from Sheet2 over to Sheet1, and get that concern out of this DeleteRandom procedure.

Now tackle the elephant in the room: make a function responsible for determining whether a row should be deleted or not.

Private Function IsNonEssentialRow(ByVal sheet As Worksheet, ByVal rowIndex As Long) As Boolean

End Function


Notice the sheet parameter: this function is going to work off a worksheet reference, and avoid another big problem with your current code: you're relying on Select and completely assume the active sheet is the sheet you need to be working with - and it might not be - or it could - or the user might have selected another sheet between two executing lines of code - regardless, your code relies on implicit references to Application.ActiveSheet, and that's bad.

Every time you call an unqualified Cells function, you make an assumption.

Keep a reference to your worksheet:

Dim sheet As Worksheet
Set sheet = ThisWorkbook.Worksheets("Sheet2")

...

If sheet.Cells(r, "C") <= 0 Then


Don't refer to them by index - the user is always free to reorder them!

Even better - sheets have a code name, which is basically a global-scope object reference that's ready to use - use it!

if Sheet2.Cells(r, "C") <= 0 Then


Select your sheet in the Project Explorer, and then hit F4 to access the properties toolwindow, and look for the CodeName property of your worksheet; give it a meaningful name, and then you can use that identifier in your VBA code.

Now, back to IsNonEssentialRow. The code should speak for itself - comments are good, but self-documenting code is better.

Dim amountPaid As Decimal
amountPaid = sheet.Cells(rowIndex, "C").Value

Dim compoundCode As Integer
compoundCode = sheet.Cells(rowIndex, "AE").Value

Dim claimType As String
claimType = sheet.Cells(rowIndex, "L").Value

Dim claimStatus As String
clainStatus = sheet.Cells(rowIndex, "J").Value

Dim categoryCode As String
categoryCode = sheet.Cells(rowIndex, "S").Value

Dim preAuth As String
preAuth = sheet.Cells(rowIndex, "N").Value

Dim groupId As String
groupId = sheet.Cells(rowIndex, "AD").Value


Now this looks like a bunch of very related values, doesn't it? How about encapsulating it into a type?

Private Type TRowItem
AmountPaid As Decimal
CompoundCode As String
ClaimType As String
ClaimStatus As String
CategoryCode As String
PreAuth As String
GroupId As String
End Type


And now you can do this:

Dim item As TRowItem
item.AmountPaid = sheet.Cells(rowIndex, "C").Value
item.CompoundCode = sheet.Cells(rowIndex, "AE").Value
item.ClaimType = sheet.Cells(rowIndex, "L").Value
item.ClaimStatus = sheet.Cells(rowIndex, "J").Value
item.CategoryCode = sheet.Cells(rowIndex, "S").Value
item.PreAuth = sheet.Cells(rowIndex, "N").Value
item.GroupId = sheet.Cells(rowIndex, "AD").Value


Now that you've read everything you needed from the worksheet (once!), you're ready to start evaluating:

Dim result As Boolean

result = result Or item.AmountPaid <= 0
result = result Or item.CompoundCode = vbNullString
result = result Or CInt(item.CompoundCode) >= 2 'todo: define magic number 2
result = result Or item.ClaimType <> "P"
result = result Or StringMatchesAny(item.ClaimStatus,"CAC","OVR","PWE")
result = result Or StringMatchesAny(item.CategoryCode,"D","I","M","N","O","P","Q","R","S")
result = result Or item.PreAuth <> 0
result = result Or Not StringMatchesAny(item.GroupId,"DS","GM","HP","LP")

IsNonEssentialRow = result


For this to work you'll need a little helper function, StringMatchesAny, which returns True if a given string matches any of a specified bunch of values, and returns as soon as it finds a match:

Public Function StringMatchesAny(ByVal source As String, ParamArray values()) As Boolean

Dim find As String, i As Integer, found As Boolean

For i = LBound(values) To UBound(values)
find = CStr(values(i))
found = (source = find)
If found Then Exit For
Next

StringMatchesAny = found

End Function


Then you could further refine the validation logic to return as soon as one of the rules evaluates to True, but I'll leave that to the reader.

With that validation logic out of the way, your DeleteNonEssentialRows procedure can focus on its task - the final code could look something like this (assuming some ToggleWaitMode(Optional ByVal wait As Boolean = True) procedure is implemented in another module):

Option Explicit
Private Type TRowItem
AmountPaid As Decimal
CompoundCode As String
ClaimType As String
ClaimStatus As String
CategoryCode As String
PreAuth As String
GroupId As String
End Type

Public Sub DeleteNonEssentialRows()

ToggleWaitMode

Dim r As Long
For r = Sheet2.UsedRange.Rows.Count To 1 Step -1
If IsNonEssentialRow(Sheet2, r) Then
Sheet2.Rows(r).EntireRow.Delete
End If
Next

ToggleWaitMode False

End Sub

Private Function IsNonEssentialRow(ByVal sheet As Worksheet, ByVal rowIndex As Long) As Boolean

Dim item As TRowItem
item.AmountPaid = sheet.Cells(rowIndex, "C").Value
item.CompoundCode = sheet.Cells(rowIndex, "AE").Value
item.ClaimType = sheet.Cells(rowIndex, "L").Value
item.ClaimStatus = sheet.Cells(rowIndex, "J").Value
item.CategoryCode = sheet.Cells(rowIndex, "S").Value
item.PreAuth = sheet.Cells(rowIndex, "N").Value
item.GroupId = sheet.Cells(rowIndex, "AD").Value

Dim result As Boolean

result = result Or item.AmountPaid <= 0
result = result Or item.CompoundCode = vbNullString
result = result Or CInt(item.CompoundCode) >= 2 'todo: define magic number 2
result = result Or item.ClaimType <> "P"
result = result Or StringMatchesAny(item.ClaimStatus,"CAC","OVR","PWE")
result = result Or StringMatchesAny(item.CategoryCode,"D","I","M","N","O","P","Q","R","S")
result = result Or item.PreAuth <> 0
result = result Or Not StringMatchesAny(item.GroupId,"DS","GM","HP","LP")

IsNonEssentialRow = result

End Function

-
– MadChadders Mar 15 at 19:23
Just a note, sheets don't have a "codename" property, they have a "Name" property (user-facing) and a "(Name)" property (codename). – Zak Mar 16 at 9:29

I was just going to comment but am short on rep, but some potential speed gainers:

You have 8 conditions for column AD, 9 for column S, 3 for column J, etc. You could store each value you wanted to check on each iteration, so you were only retrieve it once, and then combine them into a single condition.

And you could use Union to add to a range to delete after the loop has run.

Sub DeleteRandom()
Dim ADvalue As String
Dim AEvalue As String
etc.
Dim delRange As Range

With Worksheets(2)
For r = .UsedRange.Rows.Count To 1 Step -1
ADvalue = Cells(r, "AD")

If ADvalue = "940" Or ADvalue = "MMPDMBA" Or ... Then
Set delRange = AddToDeleteRange(delRange,.Rows(r).EntireRow))
ElseIf AEvalue "" Or ... Then
Set delRange = AddToDeleteRange(delRange,.Rows(r).EntireRow))
ElseIf etc...

End If
Next r
End With

If Not delRange Is Nothing Then
delRange.Delete
End If
End Sub

Private Function AddToDeleteRange(delRange As Range, addRange As Range) As Range
If delRange Is Nothing Then
Set AddToDeleteRange = addRange
Else
Set AddToDeleteRange = Union(delRange,addRange)
End If
End Function


Not particularly scalable if you needed to add in additional checks on different columns, but that is due to the requirement of varying conditions on each column.

Indentation

Correctly indenting your code is also a good idea - you won't get any performance gains out of it but it greatly increases readability and makes it easier to find what you are looking for.

-