Reputation: 71
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:
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
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
Data Example:
Issues sheet may have several CASE ID's present for one or multiple issues.
CASE ID Issue 1 Issue 2 Issue 3
DEF123 No add No num
PLZ No name
Exclusions sheet is basically a method for someone to "exclude" a particular issue for whatever reason. So if it is determined that PLZ CASE ID's not having a name is OK, then it is to be excluded from showing up on the Issues sheet.
Issue 1 Issue 2 Issue 3
DEF123 DEF123
PLZ would not show up in the above example because it is in the "EXCLUSIONS" sheet.
Upvotes: 0
Views: 402
Reputation: 5696
VBAWARD Make a copy of your data before trying this code:
You need to adapt it to your needs. I didn't quite understood when is the row gonna be empty. Any way, working with ranges may be faster and easier to debug.
Option Explicit
Sub Exclusions()
'find exclusions and remove from issues sheet. once done delete any completely blank row
' Declare objects
Dim issuesRange As Range
Dim exclusionsRange As Range
Dim issuesCell As Range
Dim exclusionsCell As Range
' Declare other variables
Dim lastRowIssues As Long
Dim lastRowExclusions As Long
' This is not recommended
On Error Resume Next
Sheets("Issues").ShowAllData
Sheets("Exclusions").ShowAllData
On Error GoTo 0
Application.ScreenUpdating = False
' Get the last row in the exclusions sheet - In this case I'd prefer to work with structured tables
lastRowExclusions = ThisWorkbook.Worksheets("Exclusions").Cells(Rows.Count, "J").End(xlUp).Row ' use full identifier with ThisWorkbook. and also use Worksheets collection as you don't need to look for graphics sheets
' Get the last row in the issues sheet - In this case I'd prefer to work with structured tables
lastRowIssues = ThisWorkbook.Worksheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row
' Store Exclusions in a range
Set exclusionsRange = ThisWorkbook.Worksheets("Exclusions").Range("J2:L" & lastRowExclusions)
' Store Issues in a range
Set issuesRange = ThisWorkbook.Worksheets("Issues").Range("A2:C" & lastRowIssues)
' Loop through each of the exclusions
For Each exclusionsCell In exclusionsRange
' Loop through each of the Issues Cells
For Each issuesCell In issuesRange
' Compare if ex is equal to iss
If exclusionsCell.Value = issuesCell Then
' Color the cell or clear its contents
'issuesCell.Interior.Color = 255
' Clear the cell contents
issuesCell.ClearContents
' Delete the whole row?
'issuesCell.Rows.EntireRow.Delete
' Delete the row if it's empty
If WorksheetFunction.CountA(ThisWorkbook.Worksheets("Issues").Range("B" & issuesCell.Row & ":D" & issuesCell.Row).Value) = 0 Then
issuesCell.Rows.EntireRow.Delete
End If
End If
Next issuesCell
Next exclusionsCell
' Restore settings
Application.ScreenUpdating = True
End Sub
Upvotes: 1