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

[monmon]

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.

 

[kevatarvind]

can you post some sample data both sheet and highlight those row which you want to delete ?

 

[JoeMo]

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.

Assumes your data start in A1 on both sheets:

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

 

[monmon]

can you post some sample data both sheet and highlight those row which you want to delete ?

Sheet 1 initially

Column A	Column B	Column C
john	88
tom	99
	00
mary	66
king	55

<tbody>
</tbody>

Sheet 2 initially

Column A	Column B	Column C
john
mary
Hebe
serina

<tbody>
</tbody>

Sheet 1 - desired results

Column A	Column B	Column C
tom	99
	00
king	55

<tbody>
</tbody>

Sheet 2 - desired results

Column A	Column B	Column C
john
mary
Hebe
serina

<tbody>
</tbody>

 

[monmon]

Assumes your data start in A1 on both sheets:

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

Thanks! That's great!! Do you mind explaining to me what the code does stating from the FOR EACH looping?

 

[JoeMo]

Thanks! That's great!! Do you mind explaining to me what the code does stating from the FOR EACH looping?

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.

 

[Peter_SSs]

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.

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

 

[drummaniac]

@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