A few words of thanks would be greatly appreciated.

Excel - A macro to delete rows with specific values

Microsoft Excel is one of the handiest tools to play around with numbers. In instances where a huge number of rows or columns are involved, Excel also has the visual basic framework that can be used to record or write custom macros. VBA macros allow users to automate the process by having a minimum user input. These macros can be customized to work on specific values or rows. The user can also customize what should be the start and end ranges for specific values or rows. All these options increase Excel's use as a data handling application.


Basically what I have is a sheet full of information about different departments and what I want to do is delete every row EXCEPT the rows that contain some specified values (which I would like to enter on running the script).

Let's say in the column that names the department (in my sheet named "Avd"), I would like the script to look for any cell that does not contain, for example, the numbers 1, 3, 5, 6 or 21... and so on (I have about 36 different numbers).


All you have to do is highlight the information in the column and then run the following Macro. There will be a box that will prompt you to select what value you want to keep. This is available for up to 30,000 rows.

Sub DeleteRows()      

Dim strToDelete As String      

Dim rngSrc As Range      

Dim NumRows As Integer      

Dim ThisRow As Integer      

Dim ThatRow As Integer      

Dim ThisCol As Integer      

Dim J As Integer      

Dim DeletedRows As Integer      

strToDelete = InputBox("Value to Trigger Keep, Jason????", "Delete Rows")      

Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address)      

NumRows = rngSrc.Rows.Count      

ThisRow = rngSrc.Row      

ThatRow = ThisRow + NumRows - 1      

ThisCol = rngSrc.Column      

Dim topRows As Integer      

Dim bottomRows As Integer      

bottomRows = 30000      

For J = ThisRow To NumRows Step 1      

If Cells(J, ThisCol) = strToDelete Then      


topRows = J      

Exit For      

DeletedRows = DeletedRows + 1      

End If      

Next J      

For J = (topRows + 1) To NumRows Step 1      

If Cells(J, ThisCol) <> strToDelete Then      


bottomRows = J      

Exit For      

'DeletedRows = DeletedRows + 1      

End If      

Next J      

If topRows <> 4 Then      

ActiveSheet.Range(Cells(4, 1), Cells(topRows - 1, 52)). Select      

Selection.delete Shift:=xlUp      

End If      

ActiveSheet.Range(Cells(bottomRows - topRows + 4, 1), Cells(30000, 52)). Select      

Selection.delete Shift:=xlUp      

'MsgBox "Number of deleted rows: " & DeletedRows      

End Sub

Note that

Thanks to Jason for this tip on the forum.

A few words of thanks would be greatly appreciated.

Ask a question
CCM is a leading international tech website. Our content is written in collaboration with IT experts, under the direction of Jeff Pillou, founder of CCM.net. CCM reaches more than 50 million unique visitors per month and is available in 11 languages.
This document, titled "Excel - A macro to delete rows with specific values," is available under the Creative Commons license. Any copy, reuse, or modification of the content should be sufficiently credited to CCM (https://ccm.net/).