VBAWARD
VBAWARD

Reputation: 71

VBA - If value in sheet1 found in sheet2, then delete data from sheet2

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

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

Answers (1)

Ricardo Diaz
Ricardo Diaz

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

Related Questions