Delete Rows Based on different Criteria in Multiple Loops

mrmmickle1

mrmmickle1

Well-known Member
Joined
May 11, 2012
Messages
2,461
Hey all. I am trying to delete rows based on several different criteria. I have used a basic format a few times to delete several different criteria. I got this code on the forum about a year ago. To use it I would simply change the criteria and just call a few of these procedures back to back to get the result I wanted. However, I am trying to learn how to do this in a loop all in one procedure to be more efficient. Here is what I have used in the past. I would just substitute out the criteria as needed:

Code: 
Sub Delete_WO()
Dim lr As Long, i As Long
lr = Range("A" & Rows.Count).End(xlUp).Row
For i = lr To 1 Step -1
    If Range("A" & i).Value = "W/O#" Then Rows(i).Delete
Next i

End Sub

I have attempted to complete the task but have had no luck. I want to "look" in column C first and find out if the value "Template" exists. If this is the case I want the whole row deleted. THen I want to do the same thing with column B. First with values that are like "BB*" and then with values like "AA*" THese values actually occur like this AA-##### or BB-###### (ex. AA-45678 or BB-54657) Here is what I have currently:
Code: 
Sub DelTemplate()

Dim  lr    As Long
Dim  i     As Long


lr = Range("C" & Rows.Count).End(xlUp).Row

For i = lr To 1 Step -1
    If Range("C" & i).Value = "Template" Then Rows(i).Delete

Next i

    Set lr = Range("B" & Rows.Count).End(xlup).Row
    If Range("B" & i).Value Like "BB*" Then Rows(i).Delete

Next i
 
    If Range("B" & i).Value Like "AA*" Then Rows(i).Delete

Next i

End Sub

Any help you could provide would be incredible!!! Thank you.
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
Code: 
Sub DeleteLoop()
Dim lastR As Long
Dim ce As Range, rng As Range, delRange As Range

lastR = WorksheetFunction.Max(Cells(Rows.Count, 2).End(xlUp).Row, Cells(Rows.Count, 3).End(xlUp).Row)
Set rng = Range("B1:B" & lastR)
For Each ce In rng
    If ce.Value Like "BB*" Or ce.Value Like "AA*" Or ce.Offset(, 1).Value = "Template" Then
        If delRange Is Nothing Then
            Set delRange = ce.EntireRow
        Else
            Set delRange = Union(delRange, ce.EntireRow)
        End If
    End If
Next
delRange.Delete

End Sub
 
Last edited:
Upvote 0
Brian,

Thank you for the quick response. I just tested the code and get an method 1004 Range of Object global failed error on the red line below:
Rich (BB code): 
Sub DeleteLoop() 
Dim lastR As Long Dim ce As Range, rng As Range, delRange As Range
  lastR = WorksheetFunction.Max(Cells(Rows.Count, 2).End(xlUp).Rows, Cells(Rows.Count, 3).End(xlUp).Rows) 
Set rng = Range("B1:B" & lastR) 
For Each ce In rng    
If ce.Value Like "BB*" Or ce.Value Like "AA*" Or ce.Offset(, 1).Value = "Template" Then        
 If delRange Is Nothing Then            
 Set delRange = ce.EntireRow        
 Else             

Set delRange = Union(delRange, ce.EntireRow)        
End If     
End If
 Next 
delRange.Delete  End Sub

Is there an easy way to fix this issue?
 
Last edited:
Upvote 0
yeah you copied my code too quickly.. LOL. No I made an update to the code above I accidently had .rows instead of .row to pull the row. You can copy the code above and try again. I am very sorry.
 
Upvote 0
No worries. I just tested it. It works like a charm. Thank you so much for the help. It is much appreciated!!!
 
Upvote 0
Brian,

Is there anyway to loop this procedure through several worksheets in an array. Initially I wanted to delete the information from the data before I moved it onto different sheets. Now I am thinking it would be better to keep all of the raw data intact. Is there anyway to define an array and loop the above procedure through about 9 separate sheets?

Could I do something like this:

Code: 
Sub DeleteInfoFromMultShts()

Dim ele                  As    Variant
Dim lastR                As    Long
Dim ce                   As    Range
Dim rng                  As    Range
Dim delRange             As    Range
Dim sheetArray(1 To 9)   As    Worksheet

    
    Set sheetArray(1) = Worksheets(1)
    Set sheetArray(2) = Worksheets(3)
    Set sheetArray(3) = Worksheets(4)
    Set sheetArray(4) = Worksheets(6)
    Set sheetArray(5) = Worksheets(7)
    Set sheetArray(6) = Worksheets(8)
    Set sheetArray(7) = Worksheets(10)
    Set sheetArray(8) = Worksheets(11)
    Set sheetArray(9) = Worksheets(15)
    
   For Each ele In sheetArray
        On Error Resume Next


Dim lastR As Long
Dim ce As Range, Dim ce As Range, delRange As Range

lastR = WorksheetFunction.Max(Cells(Rows.count, 2).End(xlUp).Row, Cells(Rows.count, 3).End(xlUp).Row)
Set rng = Range("B1:B" & lastR)
For Each ce In rng
    If ce.Value Like "AA*" Or ce.Value Like "BB*" Or ce.Value Like "*52*" Or ce.Offset(, 1).Value = "Template" Then
        If delRange Is Nothing Then
            Set delRange = ce.EntireRow
        Else
            Set delRange = Union(delRange, ce.EntireRow)
        End If
    End If
 Next

delRange.Delete

Next 

End Sub
 
Upvote 0
Do your sheets have names ??
You could use
Code: 
For Each ws In Array("sheet1", "sheet2", "sheet3") 
       Set ws = Worksheets(ws) 
           'continue working with ws as the qualifier for the worksheet
 
Upvote 0
Michael,

Thank you for the suggestion. I have tried to modify the code using the suggestion you have mentioned. I have only had to use arrays in two occasions in the past so I am not so good with figuring out the placement of the code, but I am better then when I started so at least that is a plus :) The sheets do have names. I will leave them generic for the example. This is what I have altered the code to now. I am getting a run time 424 object required error on the red code line below:
Rich (BB code): 
Sub DeleteInfoFromMultShts()

Dim lastR                As Long
Dim ce                   As Range
Dim rng                  As Range
Dim delRange             As Range
Dim ws                   As Worksheet

  
For Each ws In Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9")
  Set ws = Worksheets(ws)

lastR = WorksheetFunction.Max(Cells(Rows.count, 2).End(xlUp).Row, Cells(Rows.count, 3).End(xlUp).Row)
Set rng = Range("B1:B" & lastR)
For Each ce In rng
    If ce.Value Like "AA*" Or ce.Value Like "BB*" Or ce.Value Like "*52*" Or ce.Offset(, 1).Value = "Template" Then
        If delRange Is Nothing Then
            Set delRange = ce.EntireRow
         Else
             Set delRange = Union(delRange, ce.EntireRow)
               End If
           End If
        Next

     delRange.Delete

  Next
End Sub

You have been helping me alot lately! Any additional suggestions would be much appreciated.
 
Upvote 0
OOps, I'm having one of my Seniors days....
change to
Code: 
For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3" "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"))
 
Upvote 0
Michael,

Thanks for the adjustment. That cleared up the 424 error. Unfortunately I'm getting another error now. It's a mismatch '13'. I'm also not quite sure I have the "next" statements in the right place.... Can't really tell since the code keeps catching. THe mismatch 13 error occurs on the red line of code below:

Rich (BB code): 
Sub DeleteInfoFromMultShts()  
Dim lastR                As Long 
Dim ce                   As Range 
Dim rng                  As Range 
Dim delRange             As Range 
Dim ws                   As Worksheet     

For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3", "Sheet4", "Sheet5", "Sheet6", "Sheet7", "Sheet8", "Sheet9"))
Set ws = Worksheets(ws)  

lastR = WorksheetFunction.Max(Cells(Rows.count, 2).End(xlUp).Row, Cells(Rows.count, 3).End(xlUp).Row) 
      Set rng = Range("B1:B" & lastR) 
            For Each ce In rng     
If ce.Value Like "AA*" Or ce.Value Like "BB*" Or ce.Value Like "*52*" Or ce.Offset(, 1).Value = "Template" Then         
       If delRange Is Nothing Then             
              Set delRange = ce.EntireRow         
                     Else              
                    delRange = Union(delRange, ce.EntireRow)                
                   End If            
                 End If         
              Next       
           delRange.Delete    
        Next 
End Sub

I wish I was a little more help. I'm just trying to keep my head above water.
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
Compare cell in column to cells below
2
Replies
13
Views
601
kevin9999
K
V
  • Question
VBA: Clear Contents for Multiple Groups of Columns based on Data
Replies
3
Views
260
VBA Beginner 2024
V
K
  • Question
VBA deleterows
Replies
6
Views
116
Peter_SSs
Peter_SSs
K
  • Solved
Update to existing Move data macro
2
Replies
11
Views
284
Alex Blakenburg
A
Romano_odK
  • Question
Making it filter and not delete the lines
Replies
3
Views
169
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,214,976
Messages
6,122,543
Members
449,089
Latest member
davidcom

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top