VBA that deletes rows with criteria

Microsoft Office excel 2007 visual basic...
August 12, 2010 at 12:48:20
Specs: Windows XP
I have a macro that currently scans column C for specific ID Numbers. If ID Number (123456789 for example) appears then it deletes the entire row. However, this requires me to manually enter the select.case ID Numbers in my code. I would like to have a list of ID Numbers on one worksheet. Then I owuld like the macro to use the numbers on the worksheet as the "select.cases". This way I do not have to manually edit the code every time another ID Number is added. Thanks for the help!

The code that I have is:

Sub Exempt_List()
Dim rngStart As Range
Dim rngEnd As Range
Dim n As Integer


'RED
Sheets("red").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select
    
    
Next
'GREEN
Sheets("green").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select
    
    
Next
'BLUE
Sheets("blue").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select
    
Next
'PURPLE
Sheets("purple").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select

Next
'ORANGE
Sheets("orange").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select
    
Next
'YELLOW
Sheets("yellow").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select
    
Next
'BROWN
Sheets("brown").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select
    
Next
'GOLD
Sheets("gold").Select
'set start of data in column C
Set rngStart = Range("C2")
'find end of data in column C
Set rngEnd = Range("C" & CStr(Application.Rows.Count)).End(xlUp)

'work from end of data as deleting rows alters row numbers
For n = rngEnd.Row To rngStart.Row Step -1
    
'look for ID in column C and delete
     Select Case Range("C" & CStr(n))
      Case 123456789, 987654321
    Range("C" & CStr(n)).EntireRow.Delete
    End Select

Next n
End Sub


See More: VBA that deletes rows with criteria

Report •


#1
August 12, 2010 at 13:14:23
From a quick look at your code, I think I'd drop the Select Case method and just use .Find.

You could loop through the list of ID numbers, have VBA Find the numbers in Column C and delete the Row if found.

Unless I'm missing something, to use Select Case as you are proposing would mean looping through the list of ID's, one by one, and then looping through the list(s) in Column C looking for each item. That's a lot of looping.

.Find would find the item directly without looping through the Column C.

P.S. If you are looping through a series of sheets, always doing the same thing to each sheet, you don't have to replicate your code over and over again.

You can loop through the sheets just like you loop through a range:

For nxtSheet = 1 to Sheets.Count
 'Do stuff to the current sheet
Next

You can skip the last sheet:

For nxtSheet = 1 to Sheets.Count - 1
 'Do stuff to the current sheet
Next

Skip the first sheet:

For nxtSheet = 2 to Sheets.Count
 'Do stuff to the current sheet
Next

Skip Sheet5

 For nxtSheet = 1 to Sheets.Count
  If nxtSheet = 5 then Go To SkipIt
   'Do stuff to the current sheet
SkipIt:
 Next

Skip by name:

 For nxtSheet = 1 to Sheets.Count
  If Sheets(nxtSheet).Name = "ID List" then Go To SkipIt
   'Do stuff to the current sheet
SkipIt:
 Next

etc.

Report •
Related Solutions


Ask Question