Excel Macro for deleting rows IF cells not...

elmaco - Jul 3, 2008 at 01:48 AM
 Jo - Oct 12, 2011 at 06:38 AM

I need help to create a Excel macro.
Basicly what I have is a sheet full with information about different departments and what I want to do is delete every row EXCEPT the rows that contain some specified values (wich I would like to enter on running the script).

Lets say in the column that names the department (in my sheet named "Avd"), I would want 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).

Is there any good way to do this?

Thanks very much for your time.


3 replies

I spent a lot of time trying to figure this out and finally got the correct Macro. 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 what vaule you want to keep. This is good 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
I have a sort of similar issue, but easier. I have a worksheet that references other worksheets in the workbook. This is a quoting tool I use and so on the configure worksheet, I will select those items I need and the Proposal worksheet has IF statements for all products. Obviously I don't use all products, so I am left with a spread sheet with lots of blank rows. I would like to design a macro that will delete blank rows if the quantity (column N) is blank and to check from row 18-53. Can you help me with that? I am not a programmer and don't know VB, but would like to use the macro instead of having to go back and delete the blank rows every time. Thanks.
Are you still interested in solution? I needed it also so I've wrote a code which handle it.
Let me know,
kitkat > Umpal
Feb 4, 2010 at 05:53 AM
Hi Peter, I was looking through a thread and found that you might be able to help me. I am trying to get data from multiple tabs to copy to a front, summary tab. The summary tabs contain a varying number of lines, and lines will get added over time so I will have to copy a large range. Obviously if I just do a straight formula to copy the data across, I will end up with lots of blank lines. Is there a way of removing these blanks by using a macro to copy the data and then remove blanks? or is there some other better way of doing this?

Registration date
Thursday January 28, 2010
Last seen
May 5, 2022
769 > kitkat
Feb 4, 2010 at 07:16 AM
Give a look at

May be with slight changes it will do what you want.
Umpal > kitkat
Feb 4, 2010 at 03:25 PM
I have received an email form somebody but deleted it accidentally so I don't know who was that person and what question had.
Anyway this is what I wrote for my need. Hope it will be useful for you. (Unfortunately I don't have much time to do more for you because I'm very busy man ;)

Option Explicit
'InterlinearDeletion by Piotr Kuchno 08.01.2010
'This macro lets you delete a row that do not contain a specific string

Dim strToKeep       As String  'string that let us keep a row that contains it
Dim strToCompare    As String  'string taken from a cell(x, y)
Dim rngSrc          As Range   'field size to operate, search and delete
Dim numRows         As Long    'total number of selected rows to operate, search and delete
Dim selCol          As Long    'sel[ected] column
Dim selRow          As Long    'sel[ected] row
Dim compOut         As Integer 'com[pare] out - returns 0 in case of no match or >0 if there is a match
Dim actRow          As Long    'act[ual] row - used temporary in For/Next loop
Dim J               As Long    'for For/Next loop
Dim sheetName       As String  'keeps sheet's name (different languages have it under different name)
Dim DeletedRows     As Long    'just for an information how much rows were deleted

Private Sub cmdStart_Click()
    Call InterlinearOperation
End Sub

Private Sub InterlinearOperation()

    strToKeep = InputBox("Write a (part of) string you want to keep as a whole row:", "Keep Rows")
    If strToKeep = "" Then Exit Sub 'nothing to compare so... exit
    'strToKeep = "your string" 'you may use it instead of InputBox window
    Set rngSrc = ActiveSheet.Range(ActiveWindow.Selection.Address) 'sets the field size

    numRows = rngSrc.Rows.Count 'total number of selected rows
    selCol = rngSrc.Column      'selected column
    selRow = rngSrc.Row         'selected row
    sheetName = ActiveSheet.Name 'reads active sheet's name
    DeletedRows = 0 'have to start from the scratch
    actRow = selRow 'actRow will change so we need to leave 'selRow' intact
    For J = selRow To numRows
        strToCompare = Worksheets(sheetName).Cells(actRow, selCol) 'reads a string from cell(x, y)
        compOut = InStr(1, strToCompare, strToKeep, vbTextCompare) 'makes comparison and gives its result
        If strToCompare = "" Then compOut = 1 'cell(x, y) is empty so lets fool it to not deleting
        If compOut = 0 Then                           'not found the string we are looking for so...
            Worksheets(sheetName).Rows(actRow).Select '...selects actual row,...
            Selection.Delete Shift:=xlUp              '...deletes it and shifts all rows up
            actRow = actRow - 1 'we have one row less so we need to mark this for strToCompare
            DeletedRows = DeletedRows + 1 'counts deleted rows
        End If
        actRow = actRow + 1 'comparison is done so we need to increase this array to give the correct number to strToCompare
    Next J
    MsgBox "Number of deleted rows: " & DeletedRows

End Sub

I have the same challenge, delete every row except for a specified value in col A. I'd like to use the approach listed for the macro, where you highlight a cell's value to keep, and delete everything else. When I pasted in the macro as shown (I don't know a thing about VBA, this is my first time needing to use it), I get the message box, but no value shown that I highlighted before running the macro. I clicked ok, then got a window, "Microsoft Visual Basic, error 400". Can you help this newbe to get the code to run? I've spend days trying to get sample code to work with no results. Thanks, Jim
Is there a way to have excel delete all the empty columns in a worksheet if the "empty" columns all have a heading in the top cell?