2
\$\begingroup\$

I have 2 sheets setup: Exclusions and Issues

Issues has a list of CASE ID's and Columns that list the "Issue"

Exclusions will be populated with CASE ID's that are to be excluded (and removed) from the Issues sheet.

My question is 2 fold:

  1. Is my current code handling this correctly? Are there any ways to improve this?
  2. Is there a way to have the code cycle through all columns dynamically? Or is it just easier to copy the FOR/NEXT loop for each column on the "Issues" sheet?

Code below:

Sub Exclusions()

'find exclusions and remove from issues sheet. once done delete any completely blank row

Dim i As Long
Dim k As Long
Dim lastrow As Long
Dim lastrowex As Long
Dim DeleteRow As Long
Dim rng As Range

On Error Resume Next
    Sheets("Issues").ShowAllData
    Sheets("Exclusions").ShowAllData
On Error GoTo 0

Application.ScreenUpdating = False

lastrowex = Sheets("Exclusions").Cells(Rows.Count, "J").End(xlUp).Row

    With ThisWorkbook

        lastrow = Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row

    For k = 2 To lastrowex
        For i = 2 To lastrow
            If Sheets("Exclusions").Cells(k, 10).Value <> "" Then
                If Sheets("Exclusions").Cells(k, 10).Value = Sheets("Issues").Cells(i, 1).Value Then
                    Sheets("Issues").Cells(i, 11).ClearContents
                End If
            End If
        Next i
    Next k

    End With


On Error Resume Next
Sheets("Issues").Activate
For Each rng In Range("B2:P" & lastrow).Columns
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next rng

Application.ScreenUpdating = True

End Sub

Data Format:

"Issues" sheet

CASE ID      Issue 1     Issue 2    Issue 3
ABC123       No address  No Name    No Number

"Exclusions" sheet

Issue 1    Issue 2    Issue 3
ABC123     DEF123     ABC123
\$\endgroup\$
8
  • \$\begingroup\$ Question: what's the On Error Resume Next / GoTo 0 guarding against, specifically? Run-time error 9 when Sheets("Issues") or Sheets("Exclusions") aren't found? \$\endgroup\$ Apr 15, 2019 at 19:07
  • \$\begingroup\$ yep! also in case the filter isn't actually on. \$\endgroup\$
    – VBAWARD
    Apr 15, 2019 at 19:30
  • \$\begingroup\$ Cool. Another one: are "Issues" and "Exclusions" worksheets expected to be found in ThisWorkbook, or in whatever the ActiveWorkbook is? \$\endgroup\$ Apr 15, 2019 at 19:33
  • \$\begingroup\$ Yes, they will/should be present. \$\endgroup\$
    – VBAWARD
    Apr 15, 2019 at 19:36
  • 1
    \$\begingroup\$ I'm not seeing all the code I think, because I don't see End Sub. I imagine you're also re-enabling Application.ScreenUpdating, which I don't see either. Can you post the whole code please? \$\endgroup\$
    – PeterT
    Apr 15, 2019 at 19:39

1 Answer 1

0
\$\begingroup\$

My example you'll find below is based on most often working with large datasets and opts for speed in data handling. You didn't state the size of your Issues and Exclusions, so I worked with a large dataset in mind.

A couple quick things to get out of the way because these are good practices to make into consistent habits:

  1. Always use Option Explicit
  2. Avoid a "wall of declarations", plus the very useful other tips on that site
  3. Establish specific object variables for the worksheets, instead of always using Sheets. Further, by only using Sheets you're implying that the code should operate on the currently ActiveWorksheet. This is quite often correct, but will trip you up at some point when you intend something different.

So I make a habit of defining exactly which workbook and worksheet I'm using by initializing variables with fully qualified references.

Dim exclusionsWS As Worksheet
Dim issuesWS As Worksheet
Set exclusionsWS = ThisWorkbook.Sheets("Exclusions")
Set issuesWS = ThisWorkbook.Sheets("Issues")

While I understand your rationale for handling the possible ShowAllData errors, I would much rather be clear about "why" you need to do this. So I'd avoid the On Error Resume Next by making it clear I'm checking for a possible AutoFilter:

With exclusionsWS
    If (.AutoFilterMode And .FilterMode) Or .FilterMode Then
        .AutoFilter.ShowAllData
    End If
End With
With issuesWS
    If (.AutoFilterMode And .FilterMode) Or .FilterMode Then
        .AutoFilter.ShowAllData
    End If
End With

Next, because there may be a large dataset, I would copy the data on the worksheet into a memory-based array. Working out of memory is MUCH faster than working with the Range object in Excel. Later, the process of checking to see if a value exists in another dataset is perfect for a Dictionary. So we'll loop through all the exclusions and create a dictionary item for each entry.

Dim exclusionData As Variant
exclusionData = exclusionsWS.UsedRange

Dim exclusion As Dictionary
Set exclusion = New Dictionary
Dim i As Long
For i = 2 To lastRow
    If Not exclusionData(i, 10) = vbNullString Then
        exclusion.Add exclusionData(i, 10), i
    End If
Next i

After that, my example shows checking each Issue against the Dictionary and clearing out any excluded Issues. In order to copy the remaining issues back to the worksheet, we have to clear ALL the issues first, then copy the array data to the worksheet.

Here's the whole routine in a single view:

Option Explicit

Public Sub RemoveExclusions()
    Dim exclusionsWS As Worksheet
    Dim issuesWS As Worksheet
    Set exclusionsWS = ThisWorkbook.Sheets("Exclusions")
    Set issuesWS = ThisWorkbook.Sheets("Issues")
    With exclusionsWS
        If (.AutoFilterMode And .FilterMode) Or .FilterMode Then
            .AutoFilter.ShowAllData
        End If
    End With
    With issuesWS
        If (.AutoFilterMode And .FilterMode) Or .FilterMode Then
            .AutoFilter.ShowAllData
        End If
    End With

    Dim lastRow As Long
    With exclusionsWS
        lastRow = .Cells(.Rows.Count, "J").End(xlUp).Row
    End With

    '--- move the exclusion data to a memory-based array
    '    for processing into a dictionary
    Dim exclusionData As Variant
    exclusionData = exclusionsWS.UsedRange

    Dim exclusion As Dictionary
    Set exclusion = New Dictionary
    Dim i As Long
    For i = 2 To lastRow
        If Not exclusionData(i, 10) = vbNullString Then
            exclusion.Add exclusionData(i, 10), i
        End If
    Next i

    '--- move all the issues into a memory-based array also
    '    and clear the data from exclusion matches
    Dim issuesData As Variant
    Dim excludedCount As Long
    issuesData = issuesWS.UsedRange
    For i = 2 To UBound(issuesData, 1)
        If exclusion.Exists(issuesData(i, 10)) Then
            issuesData(i, 10) = vbNullString
            excludedCount = excludedCount + 1
        End If
    Next i

    '--- now collapse all the empty rows by copying the remaining
    '    issues into a new array, then copy the array back to the
    '    worksheet
    Dim remainingIssues As Variant
    ReDim remainingIssues(1 To UBound(issuesData, 1) - excludedCount, _
                          1 To UBound(issuesData, 2))
    Dim newIssue As Long
    newIssue = 1
    Dim j As Long
    For i = 1 To UBound(issuesData, 1)
        If Not issuesData(i, 10) = vbNullString Then
            For j = 1 To UBound(issuesData, 2)
                remainingIssues(newIssue, j) = issuesData(i, j)
            Next j
            newIssue = newIssue + 1
        End If
    Next i
    issuesWS.UsedRange.ClearContents
    issuesWS.Range("A1").Resize(UBound(remainingIssues, 1), _
                                UBound(remainingIssues, 2)) = remainingIssues
End Sub
\$\endgroup\$
1
  • \$\begingroup\$ wow! this is amazing. definitely a few concepts i still have to wrap my head around and test but thank you for this explanation. \$\endgroup\$
    – VBAWARD
    Apr 16, 2019 at 19:59

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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