Home » excel » excel – Assistance with loop efficiency

excel – Assistance with loop efficiency

Posted by: admin May 14, 2020 Leave a comment

Questions:

First off let me say thank you for your assistance with this as I am relatively new to VBA.

Currently I have a loop that runs through 5 columns to clear out any rows that have no value in Column A and then it runs through the other 4 columns to match data on another sheet in the same workbook. I have looked through multiple ways to do this more efficiently, but with no luck. Below is the loop I am currently using. I would like some ideas so the code runs more efficiently.

Dim wsDE As Worksheet
Dim wsMasterList As Worksheet
Dim City As Range
Dim State As Range
Dim AgeL As Range
Dim AgeU As Range
Dim Gender As Range
Dim x As Long
Dim lastx As Long

Set wsDE = ThisWorkbook.Sheets("DataEntry")
Set wsMasterList = ThisWorkbook.Sheets("MasterList")
Set City = wsDE.Range("B1")
Set State = wsDE.Range("C1")
Set AgeL = wsDE.Range("D1")
Set AgeU = wsDE.Range("E1")
Set Gender = wsDE.Range("F1")

lastx = wsMasterList.Range("A" & wsMasterList.Rows.Count).End(xlUp).Row
wsMasterList.Range("A1").Select

For x = 2 To lastx
    If wsMasterList.Range("A" & x) = vbNullString Then
        wsMasterList.Range("A" & x).EntireRow.Delete
        GoTo NX
    End If
    If City <> "N/A" Then
        If wsMasterList.Range("I" & x).Value <> UCase(City) Then
            wsMasterList.Range("I" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If State <> "N/A" Then
        If wsMasterList.Range("J" & x).Value <> UCase(State) Then
            wsMasterList.Range("J" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If AgeL <> "N/A" Then
        If wsMasterList.Range("E" & x) < AgeL Then
            wsMasterList.Range("E" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If AgeU <> "N/A" Then
        If wsMasterList.Range("E" & x) > AgeU Then
            wsMasterList.Range("E" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If Gender = "Male" Then
        If wsMasterList.Range("D" & x) <> "M" Then
            wsMasterList.Range("D" & x).EntireRow.Delete
            GoTo NX
        End If
    End If
    If Gender = "Female" Then
        If wsMasterList.Range("D" & x) <> "F" Then
            wsMasterList.Range("D" & x).EntireRow.Delete
            GoTo NX
        End If
    End If

NX:
Next x
How to&Answers:

The only advice I would give is to order your checks to make sure that they are ordered by the most common cases that delete a row. This reduces the number of “If” statements that have to be checked. So if AgeL normally deletes the most records, it should be your first check, then your next most common successful check should next, etc. This way you reduce the number of checks you have to do. It’s not a huge gain, but it would help some.

Answer:

I don’t know if this is any better: trades space for complexity…

It does show how to build a single range for deletion though.

Sub Tester()
    Dim wsDE As Worksheet
    Dim wsMasterList As Worksheet
    Dim City As Range
    Dim State As Range
    Dim AgeL As Range
    Dim AgeU As Range
    Dim Gender As Range
    Dim x As Long
    Dim lastx As Long, rngDel As Range, rw As Range

    Set wsDE = ThisWorkbook.Sheets("DataEntry")
    Set wsMasterList = ThisWorkbook.Sheets("MasterList")
    Set City = wsDE.Range("B1")
    Set State = wsDE.Range("C1")
    Set AgeL = wsDE.Range("D1")
    Set AgeU = wsDE.Range("E1")
    Set Gender = wsDE.Range("F1")

    lastx = wsMasterList.Range("A" & wsMasterList.Rows.Count).End(xlUp).Row

    For x = 2 To lastx

        Set rw = wsMasterList.Rows(x)
        'Only really one criteria for this check, so just pass True for crit1 ...
        '   If CheckIt returns True, then we've already flagged this row for deletion 
        '   and the other checks can be skipped
        If CheckIt(rngDel, rw, True, rw.Cells(1, "A") = vbNullString) Then GoTo NX
        If CheckIt(rngDel, rw, City <> "N/A", rw.Cells(1, "I") <> UCase(City)) Then GoTo NX
        If CheckIt(rngDel, rw, State <> "N/A", rw.Cells(1, "J") <> UCase(State)) Then GoTo NX
        If CheckIt(rngDel, rw, AgeL <> "N/A", rw.Cells(1, "E") < AgeL) Then GoTo NX
        If CheckIt(rngDel, rw, AgeU <> "N/A", rw.Cells(1, "E") > AgeU) Then GoTo NX
        If CheckIt(rngDel, rw, Gender = "Male", rw.Cells(1, "D") <> "M") Then GoTo NX
        If CheckIt(rngDel, rw, Gender = "Female", rw.Cells(1, "D") <> "F") Then GoTo NX
NX:
    Next x
    If Not rngDel Is Nothing Then rngDel.Delete
End Sub


'Function to check two criteria to see if a row should be deleted or not
'  returns true if the row is to be deleted.

'rngDelete: the range we're building for eventual deletion
'rw:        the current row being checked
'crit1:     first check (something that evaluates to True or False)
'crit2:     second check (something that evaluates to True or False)
Function CheckIt(ByRef rngDelete As Range, rw As Range, crit1 As Boolean, crit2 As Boolean) As Boolean
    CheckIt = False       '<< by default returns false
    If crit1 Then         '<< check the first and second criteria 
        If crit2 Then
            'both criteria passed, so collect the row for later deletion 
            If rngDelete Is Nothing Then
                'if "rngDelete" has no rows then use the passed row
                Set rngDelete = rw 
            Else
                'add the passed row to the range to be deleted
                Set rngDelete = Application.Union(rng, rw)
            End If
            CheckIt = True '<< return True so we can skip any other checks for deletion
        End If
    End If
End Function