A few years ago I posted a series of VBA samples on a forum which outlined different ways to delete rows in an efficient manner. The series proved to be very popular and, since that forum is now in decline, I’m going to resurrect those notes on here. The topics covered are:
- Delete Rows If Cells In A Certain Column Are Empty
- Delete Rows If Any Cells In The Row Are Empty
- Delete Rows If A Column Contains A Certain Value
- Delete Rows If A Column Does Not Contain A Certain Value
- Delete Rows If A Column Contains One Of Several Values
- Delete Rows If A Column Does Not Contain One Of Several Values
- Delete Rows From A Worksheet Based On Multiple Conditions
- Delete Rows From A Workbook Based On Multiple Conditions
The code samples will be kept as straightforward as can be: I’m not going to engineer them into a fancy class or even wrap them into generic methods (unless I’m forced to) because I want them to be directly accessible to as many users as possible. I hope you find them to be a useful reference point when you’re faced with this sort of task. Finally, a word of caution: when you run these pieces of code they will try to delete data from your workbook so please take a backup first.
Edit 26th December: A couple of blog followers suggested that these topics should be consolidated into a single post, which I’ve now done.
1. Delete Rows If Cells In A Certain Column Are Empty
Here’s a skeleton procedure to demonstrate quick and simple way to delete each
row in Sheet1 if the cells in Column A are empty:
Sub Example1()
Dim lngLastRow As Long
Dim rngToCheck As Range
Application.ScreenUpdating = False
'change Sheet1 to the codename of your sheet
With Sheet1
'if the sheet is empty then exit...
If Application.WorksheetFunction.CountA(.Cells) > 0 Then
'find the last row in the worksheet
lngLastRow = GetLastUsedRow(.Cells)
'change the "A"s to the column letter of the column you want to check
Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))
If rngToCheck.Count > 1 Then
'if there are no blank cells then there will be an error
On Error Resume Next
rngToCheck.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
On Error GoTo 0
Else
If IsEmpty(rngToCheck.Value2) Then rngToCheck.EntireRow.Delete
End If
End If
End With
Application.ScreenUpdating = True
End Sub
Public Function GetLastUsedRow( _
ByVal rngToCheck As Range, _
Optional lngLookIn As XlFindLookIn = xlFormulas _
) As Long
Const strTOFIND As String = "*"
Dim rngLast As Range
Set rngLast = rngToCheck.Find( _
What:=strTOFIND, _
LookIn:=lngLookIn, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastUsedRow = rngToCheck.Row
Else
GetLastUsedRow = rngLast.Row
End If
End Function
Just change the sheet codename and the column letters as you need.
SpecialCells From A Single Cell
Note that if rngToCheck is a single cell then the SpecialCells() method unexpectedly returns a union related to the blank cells (in this case we used the xlCellTypeBlanks constant) and used range of the sheet so I have defensively coded for this by checking rngToCheck's Count property. Since we are working with a single column the Count property will be sufficient in Excel 2007 or later – if there is a chance that the count of cells could exceed 2,147,483,647 then you should use CountLarge instead to avoid an overflow error at runtime.
Limit Of 8,192 Non-Contiguous Cells
Initially it appears that a great thing about using the Range object’s SpecialCells() method is that we can avoid having to use any looping structures.
However, something we have to be careful of is that SpecialCells() will return a reference to the entire qualifier range if there are more than 2^13 (in this case blank) non-contiguous cells. There is a MS Help and Support article describing the issue and some good news is that this issue has been resolved in Excel 2010. A more robust solution prior to Excel 2010 is to check the cell count of the first area of the SpecialCells() range and, if necessary, introduce a loop which steps through 2^14 cells at a time. Ron De Bruin describes this on his website.
Note: The later examples in this series will ignore this, but obviously bear it in mind!
Get Last Used Row
In the example used the GetLastUsedRow() function which I already described on a previous blog entry.
2. Delete Rows If Any Cells In The Row Are Empty
This example expands on the previous one but introduces yet another nuance when working with the range object’s SpecialCells() method. This example will delete all rows in the worksheet Sheet1 if the ANY of the cells within columns B to E on each row are empty. Of course, the column intersect you are checking can be changed by adjusting the column letters in the code.
Sub Example1()
Dim lngLastRow As Long
Dim rngToCheck As Range, rngToDelete As Range
Application.ScreenUpdating = False
'change Sheet1 to the codename of the sheet you want to check
With Sheet1
'find the last row on the sheet
lngLastRow = GetLastUsedRow(.Cells)
If lngLastRow > 1 Then
'we want to check the used range in columns B to E
'except for our header row which is row 1
'change the "B" and "E" to suit your needs
Set rngToCheck = .Range(.Cells(2, "B"), .Cells(lngLastRow, "E"))
'if there are no blank cells then there will be an error
On Error Resume Next
Set rngToDelete = rngToCheck.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
'allow for overlapping ranges
If Not rngToDelete Is Nothing Then _
Intersect(.Range("A:A"), rngToDelete.EntireRow).EntireRow.Delete
End If
End With
Application.ScreenUpdating = True
End Sub
Public Function GetLastUsedRow( _
ByVal rngToCheck As Range, _
Optional lngLookIn As XlFindLookIn = xlFormulas _
) As Long
Const strTOFIND As String = "*"
Dim rngLast As Range
Set rngLast = rngToCheck.Find( _
What:=strTOFIND, _
LookIn:=lngLookIn, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastUsedRow = rngToCheck.Row
Else
GetLastUsedRow = rngLast.Row
End If
End Function
The key piece of defensive coding is the part which allows for overlapping ranges. If a single row contains two non-contiguous blank cells with columns B to E then, if we try to delete the entire row directly from the union range returned by the SpecialCells() method, we will get the runtime error ‘Cannot use that command on overlapping selections’:
'this line of code could cause an error when working with more than 2 columns If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
To allow for this we resolve each empty cell found to the first column of that row and then delete:
'allow for overlapping ranges
If Not rngToDelete Is Nothing Then _
Intersect(.Range("A:A"), rngToDelete.EntireRow).EntireRow.Delete
3. Delete Rows If A Column Contains A Certain Value
The most traditional approach to tackle this task is to loop through the entire column, check to see if each cell has the value and, if it does, delete the row. Since Excel shifts rows upwards when they are deleted, it is best to start at the bottom of the column and work upwards thereby negating the row shift effect.
This approach can be quite slow (even with the Application object’s ScreenUpdating and Calculation properties set to False/Manual) for two reasons:
-
Deleting a row triggers an Excel recalculation which can be particularly time-consuming if there are a lot of formulas or links. This will happen even with calculations set to manual. So, rather than deleting each row as we identify it, the approach we will use is to take a note of it and then, once we know all the rows that need to be deleted, we delete them altogether in one go. Another approach would be to store the cell contents we want in an array, clear all the cells and then populate them from that array. This would be a good workaround which avoids deleting the rows at all but, issues such as cell formats and formula dependencies, often mean that this option isn’t viable.
-
Looping through all the cells in a column (or even just the used cells within a column) is time-consuming. We can reduce the number of iterations within the loop by using the
Rangeobject’sFind()method or, if the worksheet is set up in a suitable format, we can use theRangeobject’sAutofilter()method.
Using The Range Object’s Find Method
Sub Example1()
Const strTOFIND As String = "Hello"
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Application.ScreenUpdating = False
'change to the sheet and column you want to check
With Sheet1.Range("A:A")
Set rngFound = .Find( _
What:=strTOFIND, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
Set rngToDelete = rngFound
'note the address of the first found cell so we know where we started.
strFirstAddress = rngFound.Address
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
Set rngToDelete = Union(rngToDelete, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Using The Range Object’s Autofilter Method
This procedure assumes that Row 1 has field headers.
Sub Example2()
Const strTOFIND As String = "Hello"
Dim lngLastRow As Long
Dim rngToCheck As Range
Application.ScreenUpdating = False
'change Sheet1 to the codename of the sheet you want to check
With Sheet1
'find the last row in the Sheet
lngLastRow = GetLastUsedRow(.Cells)
'change the "A"s to the column letter you want to check
'row 1 is assumed to be a header row
Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))
End With
If lngLastRow > 1 Then
With rngToCheck
'remove the autofilter if there already is one
.Worksheet.AutoFilterMode = False
'filter by the string we want to find
.AutoFilter Field:=1, Criteria1:=strTOFIND
'assume the first row had headers
'delete the filtered rows
On Error Resume Next
.Resize(.Rows.Count - 1, 1).Offset(1, 0). _
SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
'remove the autofilter
.Worksheet.AutoFilterMode = False
End With
End If
Application.ScreenUpdating = True
End Sub
Public Function GetLastUsedRow( _
ByVal rngToCheck As Range, _
Optional lngLookIn As XlFindLookIn = xlFormulas _
) As Long
Const strTOFIND As String = "*"
Dim rngLast As Range
Set rngLast = rngToCheck.Find( _
What:=strTOFIND, _
LookIn:=lngLookIn, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastUsedRow = rngToCheck.Row
Else
GetLastUsedRow = rngLast.Row
End If
End Function
4. Delete Rows If A Column Does Not Contain A Certain Value
This is very similar to the previous post except for an inversion of the logic. Whilst inverting the logic of the Range.Autofilter() approach is easy enough, a slightly different approach with the Range.Find() method is required.
Using The Range Object’s Find / ColumnDifferences Methods
This procedure is adapted from a post by MS MVPs Richard Schollar and Rory Archibald. We search column A for the string “Hello” – which is the value we wish to keep – and then we use the Range.ColumnDifferences() method to return all the cells in the column which have a different value. Note that the Range.ColumnDifferences() method is also subject to the 8,192 non-contiguous cells limitation mentioned earlier.
Sub Example1()
Const strTOFIND As String = "Hello"
Dim lngLastRow As Long
Dim rngToCheck As Range, rngFound As Range, rngToDelete As Range
Application.ScreenUpdating = False
'change Sheet1 to the codename of the sheet you want to check
With Sheet1
lngLastRow = GetLastUsedRow(.Cells)
'assume row 1 is a header row
If lngLastRow > 1 Then
'we don't want to delete our header row
'so we start from row 2
'change the column letters to suit your needs
With .Range("A2:A" & CStr(lngLastRow))
Set rngFound = .Find( _
What:=strTOFIND, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True _
)
If rngFound Is Nothing Then
'there are no cells we want to keep!
.EntireRow.Delete
Else
'determine all the cells in the range which have a different value
On Error Resume Next
Set rngToDelete = .ColumnDifferences(Comparison:=rngFound)
On Error GoTo 0
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
End If
End With
End If
End With
Application.ScreenUpdating = True
End Sub
Public Function GetLastUsedRow( _
ByVal rngToCheck As Range, _
Optional lngLookIn As XlFindLookIn = xlFormulas _
) As Long
Const strTOFIND As String = "*"
Dim rngLast As Range
Set rngLast = rngToCheck.Find( _
What:=strTOFIND, _
LookIn:=lngLookIn, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastUsedRow = rngToCheck.Row
Else
GetLastUsedRow = rngLast.Row
End If
End Function
Using The Range Object’s Autofilter Method
The method is exactly the same for the autofilter approach in the previous example except that we change the comparison operator from “=” to “<>”. Again, a proper worksheet table structure is assumed with the field headers in row 1.
Sub Example2()
Const strTOFIND As String = "Hello"
Dim lngLastRow As Long
Dim rngToCheck As Range
Application.ScreenUpdating = False
'change Sheet1 to the codename of the sheet you want to check
With Sheet1
'find the last row in the sheet
lngLastRow = GetLastUsedRow(.Cells)
'change the "A"s to the letter of the column you want to check
'note: row 1 is the header row
Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))
End With
'only apply the filter if there's data beyond row 1
If lngLastRow > 1 Then
With rngToCheck
.Worksheet.AutoFilterMode = False
.AutoFilter field:=1, Criteria1:="<>" & strTOFIND
'assume the first row had headers
On Error Resume Next
.Resize(.Rows.Count - 1, 1).Offset(1, 0). _
SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
'remove the autofilter
.Worksheet.AutoFilterMode = False
End With
End If
Application.ScreenUpdating = True
End Sub
Public Function GetLastUsedRow( _
ByVal rngToCheck As Range, _
Optional lngLookIn As XlFindLookIn = xlFormulas _
) As Long
Const strTOFIND As String = "*"
Dim rngLast As Range
Set rngLast = rngToCheck.Find( _
What:=strTOFIND, _
LookIn:=lngLookIn, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastUsedRow = rngToCheck.Row
Else
GetLastUsedRow = rngLast.Row
End If
End Function
5. Delete Rows If A Column Contains One Of Several Values
An equally common task is to delete a row if any one of a list of words is contained within a certain column.
The discussion on the previous example applies equally and we just have to add an additional loop to iterate through the keywords. In the examples below I have used an array but you could just as easily use a range.
Using The Range Object’s Find Method
Sub Example1()
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Dim varList As Variant
Dim lngCounter As Long
Application.ScreenUpdating = False
'this is the list of words we want to find
varList = Array("Here", "There", "Everywhere")
For lngCounter = LBound(varList) To UBound(varList)
'change to the sheet and column you want to check
With Sheet1.Range("A:A")
Set rngFound = .Find( _
What:=varList(lngCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True _
)
If Not rngFound Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
Set rngToDelete = Union(rngToDelete, rngFound)
End If
strFirstAddress = rngFound.Address
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
Set rngToDelete = Union(rngToDelete, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Using The Range Object’s Autofilter Method
Note that this code is only applicable to Excel 2007 or later.
Sub Example2()
Dim lngLastRow As Long
Dim rngToCheck As Range
Dim varList As Variant
Application.ScreenUpdating = False
'this is the list of words we want to find
varList = Array("Here", "There", "Everywhere")
'change Sheet1 to the codename of the sheet you want to check
With Sheet1
'find the last row in column A
'change the "A"s to the column letter you want to check
lngLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rngToCheck = .Range(.Cells(1, "A"), .Cells(lngLastRow, "A"))
End With
'assume that row 1 is a header row
If lngLastRow > 1 Then
With rngToCheck
.Worksheet.AutoFilterMode = False
.AutoFilter _
Field:=1, _
Criteria1:=varList, _
Operator:=xlFilterValues
'assume the first row had headers
On Error Resume Next
.Resize(.Rows.Count - 1, 1).Offset(1, 0). _
SpecialCells(xlCellTypeVisible).EntireRow.Delete
On Error GoTo 0
'remove the autofilter
.Worksheet.AutoFilterMode = False
End With
End If
Application.ScreenUpdating = True
End Sub
6. Delete Rows If A Column Does Not Contain One Of Several Values
This is an adaptation of the Range.ColumnDifferences() example in section 4.
Sub Example1()
Dim varList As Variant
Dim lngLastRow As Long, lngCounter As Long
Dim rngToCheck As Range, rngFound As Range
Dim rngToDelete As Range, rngDifferences As Range
Dim blnFound As Boolean
Application.ScreenUpdating = False
'change Sheet1 to the codename of the sheet you want to check
With Sheet1
lngLastRow = GetLastUsedRow(.Cells)
'we don't want to delete our header row so we start from row 2
'change the A's to the column letter you want to check
Set rngToCheck = .Range("A2:A" & CStr(lngLastRow))
End With
If lngLastRow > 1 Then
With rngToCheck
varList = Array("Here", "There", "Everywhere")
For lngCounter = LBound(varList) To UBound(varList)
Set rngFound = .Find( _
What:=varList(lngCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
'check if we found a value we want to keep
If Not rngFound Is Nothing Then
blnFound = True
'if there are no cells with a different value then
'we will get an error
On Error Resume Next
Set rngDifferences = .ColumnDifferences(Comparison:=rngFound)
On Error GoTo 0
If Not rngDifferences Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngDifferences
Else
Set rngToDelete = Intersect(rngToDelete, rngDifferences)
End If
End If
End If
Next lngCounter
End With
If rngToDelete Is Nothing Then
If Not blnFound Then rngToCheck.EntireRow.Delete
Else
rngToDelete.EntireRow.Delete
End If
End If
Application.ScreenUpdating = True
End Sub
Public Function GetLastUsedRow( _
ByVal rngToCheck As Range, _
Optional lngLookIn As XlFindLookIn = xlFormulas _
) As Long
Const strTOFIND As String = "*"
Dim rngLast As Range
Set rngLast = rngToCheck.Find( _
What:=strTOFIND, _
LookIn:=lngLookIn, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngLast Is Nothing Then
GetLastUsedRow = rngToCheck.Row
Else
GetLastUsedRow = rngLast.Row
End If
End Function
If you want blanks to be retained then amend the array to this:
varList = Array("Here", "There", "Everywhere","")
7. Delete Rows From A Worksheet Based On Multiple Conditions
If we are checking for several keywords in an entire worksheet, the range object’s Find() method is likely to be best way. Again, we prefer to delete all the rows in one go at the end so that the routine runs more quickly.
Sub Example1()
Dim varList As Variant
Dim lngCounter As Long
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
Application.ScreenUpdating = False
'these are the values we want to find
varList = Array("Here", "There", "Everywhere")
For lngCounter = LBound(varList) To UBound(varList)
'change Sheet1 to the codename of the sheet you want to check
With Sheet1.UsedRange
Set rngFound = .Find( _
What:=varList(lngCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
8. Delete Rows From A Workbook Based On Multiple Conditions
We expand our way up the object hierarchy and arrive at the workbook level. The approach is to loop through the Worksheets collection and delete the rows on each sheet. To do this we can adjust the method on the previous post like this:
Sub Example1()
Dim wst As Worksheet
Dim strarrList() As String
ReDim strarrList(0 To 2)
'these are the values we want to find
strarrList(0) = "Here"
strarrList(1) = "There"
strarrList(2) = "Everywhere"
Application.ScreenUpdating = False
'this will delete rows from all worksheets in this workbook
For Each wst In ThisWorkbook.Worksheets
DeleteRowsFromWorksheet wst, strarrList
Next wst
Application.ScreenUpdating = True
End Sub
Sub DeleteRowsFromWorksheet(ByRef wstTarget As Worksheet, ByRef strarrList() As String)
Dim lngCounter As Long
Dim rngFound As Range, rngToDelete As Range
Dim strFirstAddress As String
For lngCounter = LBound(strarrList) To UBound(strarrList)
With wstTarget.UsedRange
Set rngFound = .Find( _
What:=strarrList(lngCounter), _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True)
If Not rngFound Is Nothing Then
strFirstAddress = rngFound.Address
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
End If
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
If Intersect(rngToDelete, rngFound.EntireRow) Is Nothing Then
Set rngToDelete = Union(rngToDelete, rngFound)
End If
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
Next lngCounter
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
End Sub
RAD Excel 
Hi Colin, this is an excellent post, thanks for the time you’ve put in here. Could you please illustrate how you would expand this to handle ‘Begins with’ or ‘Ends with’. What I am trying to do is employ a table based approach where user’s can specify fields and filter criteria’s then I will use VBA to interrogate this table calling the relevant functions like above. The final result is a parsed dataset off a user config/filter definition table
LikeLike
Hi Anthony,
If you have your data structured in a proper table format then the first option you should look at is the autofilter. The autofilter is fast and, as an added bonus, has built in functionality to do the starts with/ ends with wildcard searches you require. Once you’ve filtered the rows you are interested in you can use the Range.SpecialCells() method to get a reference to them. Provided the data isn’t massive this should all work quite efficiently. There are some examples in the post which should get you started.
LikeLiked by 1 person
Colin, you have to modify your syntax if you have a structured table in Excel 2010
rRange.SpecialCells(xlCellTypeVisible).EntireRow.Delete
does not work (rRange refers to an Excel 2010 structured table).
Use the following:
rRange.SpecialCells(xlCellTypeVisible).Rows.Delete
Tony
LikeLike
Thanks Tony, that’ll be very helpful for people reading this post who want to delete rows from tables (Listobject objects).
LikeLike
Colin,
I’m not a programmer, but know just enough VBA to customize it to suit my needs. Your various code on deleting rows has saved me literally countless hours at work. You are a brain surgeon and thanks soooooo much for sharing your knowledge! If you didn’t, I wouldn’t have a legg to stand on :)
LikeLike
Hi Colin,
thank you for the post. in topic 5 instead of varList = Array(“Here”, “There”, “Everywhere”), if i want a range list of cells what i need to to?
i tried several things but nothing worked
thank you for the help
LikeLike
Hi Ricardo,
An efficient way would be to read the range into an array (it would be a 2D array) and then loop through the array.
A slightly easier piece of coding (which is also slightly less efficient) is to use a For Each…Next loop to iterate through the cells in the range. Since you are deleting rows, it’d be best to put the list on a different sheet, otherwise you need to be very careful with what you’re doing. Something like this:
Sub Example1()Dim rngFound As Range, rngToDelete As Range
Dim rngList As Range, rngCell As Range
Dim strFirstAddress As String
Application.ScreenUpdating = False
'this is the list of words we want to find
'probably best to put it on a different sheet!
Set rngList = Sheet2.Range("A1:A5")
For Each rngCell In rngList.Cells
If Not IsEmpty(rngCell.Value2) Then
'change to the sheet and column you want to check
With Sheet1.Range("A:A")
Set rngFound = .Find( _
What:=rngCell.Value, _
Lookat:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=True _
)
If Not rngFound Is Nothing Then
If rngToDelete Is Nothing Then
Set rngToDelete = rngFound
Else
Set rngToDelete = Union(rngToDelete, rngFound)
End If
strFirstAddress = rngFound.Address
Set rngFound = .FindNext(After:=rngFound)
Do Until rngFound.Address = strFirstAddress
Set rngToDelete = Union(rngToDelete, rngFound)
Set rngFound = .FindNext(After:=rngFound)
Loop
End If
End With
End If
Next rngCell
If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
Hope that helps,
Colin
LikeLike
Good day Colin
This is a wonderful site with many options to choose from. I am however struggling to with a similar problem as Ricardo, with just a different setup. My range list is on a sheet with two columns that must be true before one can delete rows from another worksheet. In Column C are names and in column D are Yes / No’s. On the summary sheet the names are in column B.
If the range list have a No against the name then the name must be found on the summary sheet in column B and the entire row must be deleted.
I am not very good with VBA but have tried arrays and VLookup and Match, without any success. How can I change one of your suggestions to make this work for me.
Thanking you in anticipation.
LikeLike
Hi Johann,
Using Ricardo’s solution as a starting point, I think this should get you on your way:
Sub Example1() Dim rngFound As Range, rngToDelete As Range Dim vararrList() As Variant Dim lngRow As Long Dim strFirstAddress As String Dim varValueToFind As Variant Dim blnDoSearch As Boolean Application.ScreenUpdating = False 'this is the list of words we want to find 'probably best to put it on a different sheet! 'column D contains TRUE or FALSE vararrList = Sheet2.Range("C1:D5").Value For lngRow = LBound(vararrList, 1) To UBound(vararrList, 1) 'empty cells will be cast as False blnDoSearch = CBool(vararrList(lngRow, 2)) If blnDoSearch Then varValueToFind = vararrList(lngRow, 1) If Not IsEmpty(varValueToFind) Then 'change to the sheet and column you want to check With Sheet1.Range("B:B") Set rngFound = .Find( _ What:=varValueToFind, _ Lookat:=xlWhole, _ SearchOrder:=xlByRows, _ SearchDirection:=xlNext, _ MatchCase:=True _ ) If Not rngFound Is Nothing Then If rngToDelete Is Nothing Then Set rngToDelete = rngFound Else Set rngToDelete = Union(rngToDelete, rngFound) End If strFirstAddress = rngFound.Address Set rngFound = .FindNext(After:=rngFound) Do Until rngFound.Address = strFirstAddress Set rngToDelete = Union(rngToDelete, rngFound) Set rngFound = .FindNext(After:=rngFound) Loop End If End With End If End If Next lngRow If Not rngToDelete Is Nothing Then rngToDelete.EntireRow.Delete Application.ScreenUpdating = True End SubLikeLike
Colin
Thank you so much for the coding. I am however stuck at the b1nDoSearch function.
CBoo1 is returning a type mismatch and nothing I am trying is correcting it. I have Dim’ed CBoo1 and b1nDoSearch separately and together as a Variant, String and as Long but without success.
The current coding:
Dim vararrList() As Variant
Dim lngRow As Long
Dim blnDoSearch As Boolean
Dim CBoo1 As Variant
blnDoSearch = CBool(vararrList(lngRow, 2))
LikeLike
Colin
Thank you so much for the coding.
(Sorry for posting the initial reply to the “Comment” area on the website.)
The following coding is however giving a “Type Mismatch” and I have tried everything I know off to correct it but without success:
blnDoSearch = CBoo1(vararrList(lngRow, 2))
If I scan with the mouse over the coding, then I see this:
b1nDoSearch = False
CBoo1 = CBoo1(vararrList(1ngRow,2))= whilst
vararrList(1ngRow,2) gives vararrList(1ngRow,2)=”Responsible” which is the column containing the True or False.
The current Dim settings are as follows:
Dim vararrList() As Variant
‘ReDim vararrList(1 To 1)
Dim lngRow As Long
Dim strFirstAddress As String
Dim varValueToFind As Variant
Dim blnDoSearch As Boolean
Dim CBoo1 As Variant
What do I need to do to get past the “Type Mismatch” then?
Thanking you in anticipation.
LikeLike
Hi,
Sorry yes, re-reading your question I see that in your spreadsheet you have the words “Yes” and “No” which are String types. In my example I used True and False which are Boolean types.
Change:
Dim blnDoSearch As Booleanto:
Dim strDoSearch As StringChange:
blnDoSearch = CBool(vararrList(lngRow, 2))
If blnDoSearch Then
to:
strDoSearch = CStr(vararrList(lngRow, 2))
If UCase$(strDoSearch) = "YES" Then
LikeLike
Thank you so much Colin!
The code is working wonders and do exactly what I needed it to do.
LikeLike
Colin,
Thank you for the code. I do have one question. What modifications are required so that I can run “6. Delete Rows If A Column Does Not Contain One Of Several Values” but only in the first 10 rows of the spreadsheet that may contain hundreds of rows?
LikeLiked by 1 person
Pingback: Delete Rows If All Cells In A Given Range Are Empty | RAD Excel