Code Review Stack Exchange is a question and answer site for peer programmer code reviews. It's 100% free, no registration required.

Sign up
Here's how it works:
  1. Anybody can ask a question
  2. Anybody can answer
  3. The best answers are voted up and rise to the top

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
share|improve this question
    
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
1  
'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

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

Or better yet, do like @Worker suggested and add the row to a range to delete in a single step.

share|improve this answer
    
Let us continue this discussion in chat. – MadChadders Mar 15 at 19:23
1  
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.

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.