Deleting rows macro needs modifying

32CARDS

Board Regular
Joined
Jan 1, 2005
Messages
123
I have a list of rows to delete in Sheets("Sort").,
but the list has grown in Sheets("CONTROLS").

The code below works fine when there was up to 3 rows of data which is not required. So I just added and extra line of code.

How can I use a more convenient method of deleting rows as I add to the list in Sheets("CONTROLS") from Range V1 to as many as required ?

Sheets("Sort")'s data has duplicate names ( not sequential ) and can go as far as 500 + rows deep.
Thanks

Code:
Sub DelCustomRows2()
    Sheets("Sort").Select
                [D3].Select
    Do Until ActiveCell.Value = ""
    If ActiveCell.Value = Sheets("CONTROLS").Range("V1").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V2").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V3").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V4").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V5").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V6").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V7").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V8").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V9").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V10").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V11").Value Or _
    ActiveCell.Value = Sheets("CONTROLS").Range("V12").Value Then


    
    ActiveCell.EntireRow.Delete
    ActiveCell.Offset(-1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
DoEvents
Loop
DoEvents
[A2].Select
Application.ScreenUpdating = True
End Sub
 

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
Try the following code and see if it works for you. As you add more to column V in your CONTROLS sheet it will look for those values as well.

Code:
Sub DelCustomRows2()

Dim SearchRange As Range

    With Sheets("CONTROLS")
      Set SearchRange = Intersect(.UsedRange, .[V:V])
    End With
    
    Sheets("Sort").Select
                [D3].Select
    Do Until ActiveCell.Value = ""
    If SearchForValue(ActiveCell.Value, SearchRange) > 0 Then
    ActiveCell.EntireRow.Delete
    ActiveCell.Offset(-1, 0).Select
End If
ActiveCell.Offset(1, 0).Select
DoEvents
Loop
DoEvents
[A2].Select
Application.ScreenUpdating = True
End Sub

Function SearchForValue(SearchValue As Variant, SearchRange As Range) As Long
  
  On Error GoTo NotFound
  SearchForValue = Excel.WorksheetFunction.Match(SearchValue, SearchRange, False)

Exit Function

NotFound:
  SearchForValue = 0
  Err.Clear

End Function
 
Upvote 0
Hi 32CARDS (and fellow Aussie :)),

Try this (initially on a copy of your data as the results cannot be undone if they're not as expected) which as it doesn't loop is very fast:

Code:
Option Explicit
Sub Macro2()

    Const lngStartRow As Long = 3 'Starting data row number. Change to suit.
    
    Dim lngMyCol As Long, _
        lngMyRow As Long
    Dim xlnCalcMethod As XlCalculation
            
    With Application
        xlnCalcMethod = .Calculation
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    lngMyCol = Sheets("Sort").Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    lngMyRow = Sheets("Sort").Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    
    With Sheets("Sort").Columns(lngMyCol)
        With Range(Sheets("Sort").Cells(lngStartRow, lngMyCol), Sheets("Sort").Cells(lngMyRow, lngMyCol))
            .Formula = "=IF(ISERROR(VLOOKUP(D" & lngStartRow & ",CONTROLS!V:V,1,FALSE)),"""",NA())"
            ActiveSheet.Calculate
            .Value = .Value
        End With
        On Error Resume Next 'Turn error reporting off - OK to ignore 'No cells found' message
            .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete
        On Error GoTo 0 'Turn error reporting back on
        .Delete
    End With
    
    With Application
        .Calculation = xlnCalcMethod
        .ScreenUpdating = True
    End With

    MsgBox "All applicable rows from Col. D of the ""Sort"" tab have now been deleted.", vbInformation

End Sub

Regards,

Robert
 
Upvote 0
SOLVED

Both methods work great, so I have implemented both.
I can't decide which to use, so I've set the task to Odds and Evens.

An Odd numbered day uses 1 option and an Even numbered day will use the other.

The only tweak is the Msg box, had to be taken out.

Thanks
 
Upvote 0
Great! I would advise you to use one solution or the other. It may end up confusing someone else who looks at the code you have and wonders why you would alternate between the two. It won't hurt my feelings if you use Trebor's code and I'm pretty sure he'll say the same. :)
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

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