find loop delete row

[B-Man]

I currently have this working, but it has to search a few 1000 rows and it takes a fair while to run. I'm hoping it can work quicker using find but can't work out how to convert it.
if theres a match its normally 5-12 rows that will match

i want to find the rows that contain wsSource.Range("C3").Value in wsDest column A
on a match delete the matched row then look for another match.

                        Dim i As Long
                        
                        With wsDest
                            For i = wsDest.Range("A" & Rows.Count).End(xlUp).Row To 1 Step -1
                                If wsDest.Cells(i, 1) = wsSource.Range("C3").Value Then .Rows(i).Delete
                            Next i
                        End With

 

[HaHoBe]

Hi B-Man,

any chance to use the AutoFilter for this and delete the rows that match at once?

Holger

 

[kvsrinivasamurthy]

Let the sheet names are Source , Dest.

Sub DelRows()
Dim M
Dim Lr

'let the sheet names are Source , Dest
Lr = Sheets("Dest").Range("A" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(Dest!A1:A" & Lr & "=Source!C3,""A""&Row(Dest!A1:A" & Lr & "),False))"), False, False)
If UBound(M) >= 0 Then Sheets("Dest").Range(Join(M, ",")).EntireRow.Delete
End Sub

 

[B-Man]

Hi B-Man,

any chance to use the AutoFilter for this and delete the rows that match at once?

Holger

That would work.
Should be fast too
Will look into it

 

[Peter_SSs]

Let the sheet names are Source , Dest.

Sub DelRows()
Dim M
Dim Lr

'let the sheet names are Source , Dest
Lr = Sheets("Dest").Range("A" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(Dest!A1:A" & Lr & "=Source!C3,""A""&Row(Dest!A1:A" & Lr & "),False))"), False, False)
If UBound(M) >= 0 Then Sheets("Dest").Range(Join(M, ",")).EntireRow.Delete
End Sub

That will likely fail. It does depend on how many rows it finds to delete but there is a limit on the length of the address string in this part of the code.
Sheets("Dest").Range(Join(M, ",")).EntireRow.Delete

OP says a few thousand rows. With my sample data with just 2,000 rows where only 1 in 20 rows needed to be deleted the code errored on that line due to the address string length.

That would work.
Should be fast too
Will look into it

This should be much faster than AutoFilter and Delete, particularly if you have quite a few disjoint rows to delete.

I have also called my sheets "Source" and "Dest".

Sub Del_Rws()
  Dim a As Variant, b As Variant, Val As Variant
  Dim nc As Long, i As Long, k As Long
 
  Val = Sheets("Source").Range("C3").Value
  With Sheets("Dest")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = Val Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A1").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

 

[B-Man]

That will likely fail. It does depend on how many rows it finds to delete but there is a limit on the length of the address string in this part of the code.
Sheets("Dest").Range(Join(M, ",")).EntireRow.Delete

OP says a few thousand rows. With my sample data with just 2,000 rows where only 1 in 20 rows needed to be deleted the code errored on that line due to the address string length.


This should be much faster than AutoFilter and Delete, particularly if you have quite a few disjoint rows to delete.

I have also called my sheets "Source" and "Dest".

Sub Del_Rws()
  Dim a As Variant, b As Variant, Val As Variant
  Dim nc As Long, i As Long, k As Long
 
  Val = Sheets("Source").Range("C3").Value
  With Sheets("Dest")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = Val Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A1").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

Ok thanks I'll try that

 

[kvsrinivasamurthy]

If code in post#3 is not working then try,

Sub DelRows()
Dim M
Dim Lr As Long, T As Long, Str As String
'Let the sheet names are Source , Dest
Application.ScreenUpdating = False
Lr = Sheets("Dest").Range("A" & Rows.Count).End(xlUp).Row
M = Filter(Evaluate("Transpose(If(Dest!A1:A" & Lr & "=Source!C3,""A""&Row(Dest!A1:A" & Lr & "),False))"), False, False)
For T = UBound(M) To 0 Step -1
Str = Str & "," & M(T)
If T = 0 Or T Mod 20 = 0 Then
Sheets("Dest").Range(Mid(Str, 2)).EntireRow.Delete
Str = ""
End If
Next T
Application.ScreenUpdating = True
End Sub

 

[HaHoBe]

Hi kvsrinivasamurthy,

have a look at Copy individual range based on highlighted last cell from sheet to another where I tried to explain why your code must fail (using absolute addresses when only 256 characters are available is not really smart).

Holger

 

[B-Man]

That will likely fail. It does depend on how many rows it finds to delete but there is a limit on the length of the address string in this part of the code.
Sheets("Dest").Range(Join(M, ",")).EntireRow.Delete

OP says a few thousand rows. With my sample data with just 2,000 rows where only 1 in 20 rows needed to be deleted the code errored on that line due to the address string length.


This should be much faster than AutoFilter and Delete, particularly if you have quite a few disjoint rows to delete.

I have also called my sheets "Source" and "Dest".

Sub Del_Rws()
  Dim a As Variant, b As Variant, Val As Variant
  Dim nc As Long, i As Long, k As Long
 
  Val = Sheets("Source").Range("C3").Value
  With Sheets("Dest")
    nc = .Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column + 1
    a = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
    ReDim b(1 To UBound(a), 1 To 1)
    For i = 1 To UBound(a)
      If a(i, 1) = Val Then
        b(i, 1) = 1
        k = k + 1
      End If
    Next i
    If k > 0 Then
      Application.ScreenUpdating = False
      With .Range("A1").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

worked a treat thanks.

 

[Peter_SSs]

your code must fail

Which code?

worked a treat thanks.

You're welcome. Thanks for the follow-up.