OzGrid

How to use Excel VBA to delete rows in a column based on a range of cells in another Column

< Back to Search results

 Category: [Excel]  Demo Available 

How to use Excel VBA to delete rows in a column based on a range of cells in another Column

 

Requirement:

 

The user has an Excel sheet and have been trying to use VBA to delete rows based on the values in column B, provided they match values currently residing in column C. The user is a coding novice and have so far only gotten to a point of managing to delete a row by selecting a single cell in column C (Example, if the user were to select column B as a range and then select the cell in column C containing the value 331013, the row containing the same value in column B will be deleted (in this case the first row).

 

https://www.ozgrid.com/forum/forum/help-forums/excel-vba-macros/1203687-excel-vba-delete-rows-in-a-column-based-on-a-range-of-cells-in-another-column

What the user wants to do is to select the entire range of values in column C so the user can delete all of the rows with matching values in column B in a single batch.

The following is what the user has managed so far based on a lot of googling, it is working with just one selection, but when the user manually select more than 1 cell it just deletes the corresponding value of the first selection and if the user selects  the entire column range the user gets a mismatch error or a stack overflow error.

Code:
Sub DeleteRows()

Dim rng As Range
Dim InputRng As Range
Dim DeleteRng As Range
Dim DeleteStr As Range

xTitleId = "Input"

Set InputRng = Application.Selection
Set DeleteStr = Application.Selection

Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set DeleteStr = Application.InputBox("delete range :", xTitleId, DeleteStr.Address, Type:=8)
For Each rng In InputRng
    If rng.Value = DeleteStr Then
        If DeleteRng Is Nothing Then
            Set DeleteRng = rng
        Else
            Set DeleteRng = Application.Union(DeleteRng, rng)
        End If
    End If
Next
DeleteRng.EntireRow.Delete
End Sub


The user was then told to use a for loop to count backwards through the cells and did the following:

Code:
Sub DeleteRows()

Dim i As Integer
Dim InputRng As Range
Dim DeleteRng As Range

xTitleId = "Input"

Set InputRng = Application.Selection
Set DeleteRng = Application.Selection

Set InputRng = Application.InputBox("Range :", xTitleId, InputRng.Address, Type:=8)
Set DeleteRng = Application.InputBox("delete range :", xTitleId, DeleteRng.Address, Type:=8)

For i = InputRng To 1 Step -1
    If IsError(Application.Match(Cells(i, 2), DeleteRng, 0)) Then
  Rows(i & ":" & i).EntireRow.Delete
End If
Next i

End Sub

However,  the user is still getting a mismatch error even with the If statement to catch the error.

 

Solution:

 

Code:
Sub DelRows()
    Application.ScreenUpdating = False
    Dim LastRow As Long
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Dim foundVal As Range
    Dim x  As Long
    For x = LastRow To 2 Step -1
        If Cells(x, 3) <> "" Then
            Set foundVal = Range("B:B").Find(Cells(x, 3), LookIn:=xlValues, lookat:=xlWhole)
            If Not foundVal Is Nothing Then
                foundVal.EntireRow.Delete
            End If
        End If
    Next x
    Application.ScreenUpdating = True
End Sub

 

Obtained from the OzGrid Help Forum.

Solution provided by Mumps.

 

See also: Index to Excel VBA Code and Index to Excel Freebies and Lesson 1 - Excel Fundamentals and Index to how to… providing a range of solutions and Index to new resources and reference sheets

 

See also:

How to use VBA code to highlight rows
How to copy non-blank rows in a range and paste to other sheets
How to hide rows based on 2 value
How to use VBA code to copy rows from one sheet to another excluding empty rows

 

Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.


Gallery



stars (0 Reviews)