How to delete row if cell value equals cell value in another sheet? VBA

M

monmon

Board Regular
Joined
Apr 1, 2013
Messages
84
Dear all, I have tried to search on other forums but can't seem to find an answer. Please help for VBA.

I have some data in sheet 1 column A. However, the amount of data varies everytime. In addition, blanks cells may be present in column A as well.

I have some data in sheet 2 column A. The amount of data also varies everytime. In addition, blank cells maybe present as well.

what I need here is to match the values in column A sheet 1 to column A sheet 2, and if it matches to delete the entire row in sheet 1.

However, i want to keep all blank cells in column A sheet 1.

Sheet 2 blank cells to be removed if any.

how do I do that in VBA? A lot of forums talk about a specific value but none on non specific values. Please help.
 
Sort by date Sort by votes
can you post some sample data both sheet and highlight those row which you want to delete ?
 
Upvote 0
monmon said:
Dear all, I have tried to search on other forums but can't seem to find an answer. Please help for VBA.

I have some data in sheet 1 column A. However, the amount of data varies everytime. In addition, blanks cells may be present in column A as well.

I have some data in sheet 2 column A. The amount of data also varies everytime. In addition, blank cells maybe present as well.

what I need here is to match the values in column A sheet 1 to column A sheet 2, and if it matches to delete the entire row in sheet 1.

However, i want to keep all blank cells in column A sheet 1.

Sheet 2 blank cells to be removed if any.

how do I do that in VBA? A lot of forums talk about a specific value but none on non specific values. Please help.
Click to expand...
Assumes your data start in A1 on both sheets:
Code: 
Sub monmon()
Dim S1 As Worksheet, S2 As Worksheet, lR1 As Long, lR2 As Long, _
    dRws As Range, c As Range, n As Long
Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")
lR1 = S1.Range("A" & Rows.Count).End(xlUp).Row
lR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each c In S1.Range("A1", "A" & lR1)
    If Not IsEmpty(c) Then
        n = 0
        On Error Resume Next
        n = Application.Match(c.Value, S2.Range("A1", "A" & lR2), 0)
        On Error GoTo 0
        If n > 0 Then
            If Not dRws Is Nothing Then
                Set dRws = Union(dRws, c.EntireRow)
            Else
                Set dRws = c.EntireRow
            End If
        End If
    End If
Next c
If Not dRws Is Nothing Then dRws.Delete
Set dRws = Nothing
For Each c In S2.Range("A1", "A" & lR2)
    If IsEmpty(c) Then
        If Not dRws Is Nothing Then
            Set dRws = Union(dRws, c.EntireRow)
        Else
            Set dRws = c.EntireRow
        End If
    End If
Next c
If Not dRws Is Nothing Then dRws.Delete
End Sub
 
Upvote 0
kevatarvind said:
can you post some sample data both sheet and highlight those row which you want to delete ?
Click to expand...


Sheet 1 initially

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[/TR]
[TR]
[TD]john
[/TD]
[TD]88
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]tom
[/TD]
[TD]99
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]00
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mary
[/TD]
[TD]66
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]king
[/TD]
[TD]55
[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2 initially

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[/TR]
[TR]
[TD]john
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mary
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Hebe
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]serina
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]



Sheet 1 - desired results
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[/TR]
[TR]
[TD]tom
[/TD]
[TD]99
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD]00
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]king
[/TD]
[TD]55
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]


Sheet 2 - desired results
[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD]Column A
[/TD]
[TD]Column B
[/TD]
[TD]Column C
[/TD]
[/TR]
[TR]
[TD]john
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]mary
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]Hebe
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]serina
[/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]
 
Upvote 0
JoeMo said:
Assumes your data start in A1 on both sheets:
Code: 
Sub monmon()
Dim S1 As Worksheet, S2 As Worksheet, lR1 As Long, lR2 As Long, _
    dRws As Range, c As Range, n As Long
Set S1 = Sheets("Sheet1")
Set S2 = Sheets("Sheet2")
lR1 = S1.Range("A" & Rows.Count).End(xlUp).Row
lR2 = S2.Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For Each c In S1.Range("A1", "A" & lR1)
    If Not IsEmpty(c) Then
        n = 0
        On Error Resume Next
        n = Application.Match(c.Value, S2.Range("A1", "A" & lR2), 0)
        On Error GoTo 0
        If n > 0 Then
            If Not dRws Is Nothing Then
                Set dRws = Union(dRws, c.EntireRow)
            Else
                Set dRws = c.EntireRow
            End If
        End If
    End If
Next c
If Not dRws Is Nothing Then dRws.Delete
Set dRws = Nothing
For Each c In S2.Range("A1", "A" & lR2)
    If IsEmpty(c) Then
        If Not dRws Is Nothing Then
            Set dRws = Union(dRws, c.EntireRow)
        Else
            Set dRws = c.EntireRow
        End If
    End If
Next c
If Not dRws Is Nothing Then dRws.Delete
End Sub
Click to expand...

Thanks! That's great!! Do you mind explaining to me what the code does stating from the FOR EACH looping?
 
Upvote 0
monmon said:
Thanks! That's great!! Do you mind explaining to me what the code does stating from the FOR EACH looping?
Click to expand...
Glad it helped.

The first for-each looks at every cell in sheet1 column A from the first cell to the last filled cell in that column and if the cell is not blank it checks to see if the cell 's contents can be found in any cell in sheet2, column A (from A1 through the last filled cell in that column). If there is a match, the row the cell in sheet1 is in is stored in a range variable called dRws. When all cells in sheet1 have been checked. The range dRws is deleted per your request and dRws is set to Nothing to clear the variable to be used again in the final procedure. Finally, each cell in sheet2 column A is checked to see if it is blank. If so, it is stored in dRws and after all cells have been checked, dRws which contains all blank cells in sheet2 column A is deleted.

Deleting cells and/or rows takes significant time. That's why I use the range variable to store the rows to be deleted, then delete them all in one shot which is very fast. The difference in run time may not be noticeable if you have only a few hundred rows/cells to delete one at a time, but try doing this on thousands of rows and you can step out for a cup of coffee before the macro completes.
 
Upvote 0
I've suggested a non-looping code. My assumptions are
- Sheet1: Headings in A1 & B1, no data in columns C:E

If assumption are incorrect & you would like to pursue this approach further, please post back with more details.
Code: 
Sub TidyUpRows()
  Dim lr As Long
  
  Application.ScreenUpdating = False
  With Sheets("Sheet1")
    lr = .Range("B" & .Rows.Count).End(xlUp).Row
    .Range("C2").Formula = "=OR(A2="""",COUNTIF('Sheet2'!A:A,A2)=0)"
    .Range("A1:B" & lr).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
      .Range("C1:C2"), CopyToRange:=.Range("D1"), Unique:=False
    .Columns("A:C").Delete
  End With
  On Error Resume Next
  Sheets("Sheet2").Columns("A").SpecialCells(xlBlanks).EntireRow.Delete
  On Error GoTo 0
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
@JoeMo,

I had the same problem and this code works great but I was wondering what I could do to it so that if they do match but if the quantity in sheet1 (lets say the 5th cell in that row) has a value of anything above or below zero then it wont delete the row and leave it with the rest of the unmatched cells in A
 
Upvote 0
You must log in or register to reply here.

Similar threads

T
  • Solved
Large Sheet-Need to Get blank cells to equal proceeding cell when blank
Replies
2
Views
163
TWTHOMAS
T
L
  • Question Question
VBA Move Row by Cell Data
Replies
8
Views
405
Joe4
Joe4
Z
  • Solved
Delete cells in a TABLE that do not contain a specific string
Replies
4
Views
150
Zale
Z
I
  • Question Question
Load Listbox only if two values are present in two cells otherwise ignore & continue down the sheet
Replies
6
Views
137
ipbr21054
I
K
  • Question Question
Two Column VBA Drop Down only to show rows for non-blank cells.
Replies
0
Views
57
keromero
K

Forum statistics

Threads
1,226,859
Messages
6,193,397
Members
453,793
Latest member
MillionMonkeys

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top