Help with looping code

[Trueblue862]

Hi,
I have this piece of code which finds the value "Del" in column "M" and if that value is present it deletes that row, it works perfectly but I need it to loop until there are no cells with "Del" in them. I'm just not sure how to set it up with a Do Until loop function. Any help with this would be appreciated.

Private Sub BtnDel_Click()

    Sheets("Mail Merge").Activate
   
    
    iSelected = ("Del")
    lR = Cells(Rows.Count, "M").End(xlUp).Row
    Set rData = Range("M2:M" & lR).Find(iSelected, LookIn:=xlValues, lookat:=xlWhole)
    If rData Is Nothing Then: Exit Sub
        ans = rData.Row
        Rows(ans).EntireRow.Delete
   
End Sub

 

[Saurabhj]

Hi,

Please use below code:

Private Sub BtnDel_Click()

    Sheets("Mail Merge").Activate
       
    rowno = 2
    Do While Not (IsEmpty(Cells(rowno, "M")))
        If InStr(1, Cells(rowno, "M"), "Del") > 0 Then
            Cells(rowno, "M").EntireRow.Delete
        Else
            rowno = rowno + 1
        End If
    Loop
   
End Sub

 

[MARK858]

You don't need to use a loop, you can just use the AutoFilter

Sub Filterit()
    Application.ScreenUpdating = False
    
    With Sheets("Mail Merge").Range("M1:M" & Sheets("Mail Merge").Range("M" & Rows.Count).End(xlUp).Row)
    
        .AutoFilter 1, "Del"
        
        On Error Resume Next
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
        On Error GoTo 0
        .AutoFilter
    
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[vcoolio]

Hello TrueBlue,

Another option is to use Autofilter:-

Private Sub BtnDel_Click()
  
        Dim wsMM As Worksheet: Set wsMM = Sheets("Mail Merge")
  
Application.ScreenUpdating = False

        With wsMM.[A1].CurrentRegion
                .AutoFilter 13, "Del"
                .Offset(1).EntireRow.Delete
                .AutoFilter
        End With
        
Application.ScreenUpdating = True

End Sub

I hope that this helps.

Cheerio,
vcoolio.

 

[Fluff]

Another way

Private Sub BtnDel_Click()
   With Sheets("Mail merge").Range("H:H")
      .Replace "Del", True, xlWhole, , False, , False, False
      On Error Resume Next
      .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
      On Error GoTo 0
   End With
End Sub

 

[MARK858]

Hi @Fluff I think that you have made a typo with the columns and should be column M not H.

 

[Fluff]

Thanks for spotting that Mark, forgot to change it back after doing a quick speed test.
As Mark has pointed out it should be

Private Sub BtnDel_Click()
   With Sheets("Mail merge").Range("M:M")
      .Replace "Del", True, xlWhole, , False, , False, False
      On Error Resume Next
      .SpecialCells(xlConstants, xlLogical).EntireRow.Delete
      On Error GoTo 0
   End With
End Sub

 

[Peter_SSs]

.. and if your data set is large with "Del" values scattered throughout, this should be considerably faster than all the previous suggestions.

Sub Delete_Del()
  Dim a As Variant, b As Variant
  Dim nc As Long, i As Long, k As Long
  
  With Sheets("Mail Merge")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("M2", .Range("M" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = "Del" Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A2").Resize(UBound(a), nc)
        .Columns(nc).Value = b
        .Sort Key1:=.Columns(nc), Order1:=xlAscending, Header:=xlNo
        .Resize(k).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
    End If
  End With
End Sub

 

[Trueblue862]

Thanks every one for your help. I ended up using Fluff's code. Worked a treat, thank you.

 

[Fluff]

Glad we could help & thanks for the feedback.