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:
- Always use
Option Explicit
- Avoid a "wall of declarations", plus the very useful other tips on that site
- 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
On Error Resume Next / GoTo 0
guarding against, specifically? Run-time error 9 whenSheets("Issues")
orSheets("Exclusions")
aren't found? \$\endgroup\$"Issues"
and"Exclusions"
worksheets expected to be found inThisWorkbook
, or in whatever theActiveWorkbook
is? \$\endgroup\$End Sub
. I imagine you're also re-enablingApplication.ScreenUpdating
, which I don't see either. Can you post the whole code please? \$\endgroup\$