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
asked Apr 15, 2019 at 17:25
\$\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\$ Commented Apr 15, 2019 at 19:07
  • \$\begingroup\$ yep! also in case the filter isn't actually on. \$\endgroup\$ Commented 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\$ Commented Apr 15, 2019 at 19:33
  • \$\begingroup\$ Yes, they will/should be present. \$\endgroup\$ Commented 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\$ Commented Apr 15, 2019 at 19:39

1 Answer 1

1
\$\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
answered Apr 16, 2019 at 14:53
\$\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\$ Commented Apr 16, 2019 at 19:59

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.