VBA code find multi text and delete entire rows

[ChristinaAC]

Hi there,

I have the below code of which I am trying to use on a large amount of data. The column that the search needs to look in is Column A, starting from cell A2. The text that it needs to find is "670164661 - 00001" and "10000011823", if it finds this content in any of the rows in column A, then it should delete the entire row.

Unfortunately there is an error with my code and but I'm not sure why, it keeps highlighting the second to last "Ends with", to say that its not needed.

Please let me know if you can help.

Thank you so much


Sub Findanddeleterows()

Dim FirstRow As Long
Dim LastRow As Long
Dim Looprow As Long
Dim CalcMode As Long
Dim ViewMode As Long

'creating the name for first and last row etc

With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False

End With

With ActiveSheet
.Select
'selecting active sheet to use formula on

ViewMode = ActiveWindow.View
ActiveWindow.View = xlNormalView
.DisplayPageBreaks = False
'if you are in page break/page layout view to normal view and turns off display page breaks

FirstRow = 2
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'setting parameters for first row as cell 2 and for the formula to find the last row - this will enable the data level to continue to grow and for the formula to still work

For Looprow = LastRow To FirstRow Step -1
'Starting the find and delete on the last to first row less the heading
With Cells(Looprow, "A")
If Not IsError(.Value) Then

If .Value = "67016997 - 1" Then .EntireRow.Delete
If .Value = "10000011823" Then .EntireRow.Delete

End With
Next Looprow
End With

End Sub

 

[ChristinaAC]

Hi Hiker95

Please see below the answers to your questions;

1 - I am using Excel 2010
2 - I am using a PC
3 - The mobile numbers are all listed in column A as '07712455281

I have been playing around with coding all day but can't get it to search through and delete any rows that start with '0.

Any help would be greatly appreciated, I am quite new to this but am really trying hard to learn and understand.

Thank you

 

[hiker95]

3 - The mobile numbers are all listed in column A as '07712455281

I have been playing around with coding all day but can't get it to search through and delete any rows that start with '0.

ChristinaAC,

In order to continue, and, so that I can get it right on the next try, I would like to see an actual raw data workbook/worksheet with a good sampling of just column A containing actual/fake mobile numbers in their current formatting.

Try the following site:

https://dropbox.com

 

[Peter_SSs]

Is there a way to find and delete any rows that do not begin with 0?

... delete any rows that start with '0.

Which one of these are you actually trying to do?

 

[Peter_SSs]

Which one of these are you actually trying to do?

Try this for deleting rows that do NOT start with 0
If that is the wrong way around, replace the red text in the code with =

Sub RemoveThem()
  Dim LR As Long, LC As Long, i As Long, rws As Long
  Dim aCol, tmp
                           
  LR = Range("A" & Rows.Count).End(xlUp).Row
  LC = Cells(1, Columns.Count).End(xlToLeft).Column
  aCol = Range("A2:A" & LR).Value
  ReDim tmp(1 To LR - 1, 1 To 1)
  For i = 1 To LR - 1
      If Left(aCol(i, 1), 1) <> "0" Then
          rws = rws + 1
          tmp(i, 1) = 1
      End If
  Next i
  If rws > 0 Then
      Application.ScreenUpdating = False
      Cells(2, LC + 1).Resize(LR - 1).Value = tmp
      With Range("A2").Resize(LR - 1, LC + 1)
          .Sort Key1:=.Cells(1, LC + 1), Order1:=xlAscending, Header:=xlNo
          .Resize(rws).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
  End If
End Sub

 

[Rick Rothstein]

Try this for deleting rows that do NOT start with 0
If that is the wrong way around, replace the red text in the code with =

Sub RemoveThem()
  Dim LR As Long, LC As Long, i As Long, rws As Long
  Dim aCol, tmp
                           
  LR = Range("A" & Rows.Count).End(xlUp).Row
  LC = Cells(1, Columns.Count).End(xlToLeft).Column
  aCol = Range("A2:A" & LR).Value
  ReDim tmp(1 To LR - 1, 1 To 1)
  For i = 1 To LR - 1
      If Left(aCol(i, 1), 1) <> "0" Then
          rws = rws + 1
          tmp(i, 1) = 1
      End If
  Next i
  If rws > 0 Then
      Application.ScreenUpdating = False
      Cells(2, LC + 1).Resize(LR - 1).Value = tmp
      With Range("A2").Resize(LR - 1, LC + 1)
          .Sort Key1:=.Cells(1, LC + 1), Order1:=xlAscending, Header:=xlNo
          .Resize(rws).EntireRow.Delete
      End With
      Application.ScreenUpdating = True
  End If
End Sub

On my computer, your code took 0.56 second to process 20 columns of data that stretched from Row 1 to Row 15000 (where Column A had no blank cells within the data area)... in total, 6924 rows of data were removed The following code took 0.32 seconds to process the identical data.

Sub NumbersStartingWithZeroOnly()
  Dim R As Long, C As Long, X As Long, Data As Variant, Results As Variant
  Data = Range("A1").CurrentRegion
  ReDim Results(1 To UBound(Data, 1), 1 To UBound(Data, 2))
  For R = 1 To UBound(Data)
    If Left(Data(R, 1), 1) = "0" Then
      X = X + 1
      For C = 1 To UBound(Data, 2)
        Results(X, C) = Data(R, C)
      Next
    End If
  Next
  Range("A1").CurrentRegion = Results
End Sub

 

[Rick Rothstein]

On my computer, your code took 0.56 second to process 20 columns of data that stretched from Row 1 to Row 15000 (where Column A had no blank cells within the data area)... in total, 6924 rows of data were removed The following code took 0.32 seconds to process the identical data.

Sub NumbersStartingWithZeroOnly()
  Dim R As Long, C As Long, X As Long, Data As Variant, Results As Variant
  Data = Range("A1").CurrentRegion
  ReDim Results(1 To UBound(Data, 1), 1 To UBound(Data, 2))
  For R = 1 To UBound(Data)
    If Left(Data(R, 1), 1) = "0" Then
      X = X + 1
      For C = 1 To UBound(Data, 2)
        Results(X, C) = Data(R, C)
      Next
    End If
  Next
  Range("A1").CurrentRegion = Results
End Sub

As a follow up, keeping the same amount of data, but making it so that only one row would qualify for deletion... in that case, my code took 0.45 seconds whereas your code only took 0.05 seconds. So, while my code is faster than yours if (as a guess) 20% or more rows will end up being deleted, the time difference between our codes is not significant enough to evaluate the anticipated number of rows to be deleted in order to determine which routine to use... I would recommend the OP just use your code no matter what... well, I would recommend that as long as the OP doesn't have 500,000 rows of data (new tests would be required if the number of rows of data is massive as I do not have a feel how either routine will fair under such a load).

 

[Peter_SSs]

Rick
I agree that the differences are not too critical.
I went for the approach I did as it would preserve any formulas that may have been included on the sheet.
The time for your code would also increase/decrease depending on the number of columns.

 

[Rick Rothstein]

Rick
I went for the approach I did as it would preserve any formulas that may have been included on the sheet.

I believe assigning formulas to the Data variable ends up preserving them with my code as well...

Data = Range("A1").CurrentRegion.Formula

With that said, I would still recommend your macro over mine.

 

[ChristinaAC]

Hi Peter,

So sorry for the delay, I have been away. This code worked a charm! Thank you so much - you have made me the happiest person!

I know this might be a pain for you but in order for me to try and learn from your code, would you please be able to explain it a little to me?

Thank you again so so much

Also thank you to all of you that helped!

 

[Peter_SSs]

Hi Peter,

So sorry for the delay, I have been away. This code worked a charm! Thank you so much - you have made me the happiest person!

I know this might be a pain for you but in order for me to try and learn from your code, would you please be able to explain it a little to me?

Thank you again so so much

Also thank you to all of you that helped!

Glad it worked for you.

Identifying relevant rows and deleting them individually is relatively slow.
The same goes for identifying & deleting them all at once, say by using AutoFilter, if they consist of many disjoint rows.

If your data is not too big then none of that will matter but if your data is large or you just want faster code then it is much faster to identify all the relevant rows, get them all together in a single block & then delete that single block of rows. That is the approach of my code.

Further detailed comments in the code below.

Sub RemoveThem()
  Dim LR As Long, LC As Long, i As Long, rws As Long
  Dim aCol, tmp
                          
  'Find last row/last column by looking backwards from the bottom/right of the sheet
  'in the first column/row
  LR = Range("A" & Rows.Count).End(xlUp).Row
  LC = Cells(1, Columns.Count).End(xlToLeft).Column
  
  'Read all the data from col A into an array in memory.
  'Using an array like this is much faster that referring back to the worksheet all the time
  aCol = Range("A2:A" & LR).Value
  
  'Make a tmp array the same size
  ReDim tmp(1 To LR - 1, 1 To 1)
  
  'Work through the data array (phone numbers)
  For i = 1 To LR - 1
  
      'If the number does not start with 0 then ...
      If Left(aCol(i, 1), 1) <> "0" Then
      
          'It will need to be deleted, so keep a count of how many rows need deleting and ..
          rws = rws + 1
          
          'Place a 1 in the corresponding position of the tmp array.
          'For other rows this position in the array will remain empty
          tmp(i, 1) = 1
          
      End If
  Next i
  
  'If we found any rows that need deleting then ..
  If rws > 0 Then
  
      'Turn off screen updating to speed the code & stop screen flicker
      Application.ScreenUpdating = False
      
      'In the first available empty column, enter the values from tmp array
      'This simply places a 1 beside every row that needs to be deleted
      Cells(2, LC + 1).Resize(LR - 1).Value = tmp
      
      'With the whole sheet, including this tmp column
      With Range("A2").Resize(LR - 1, LC + 1)
      
          'Sort the data based on the tmp column.
          'All the "1" rows will sort to the top (row 2 down) with blanks (keep rows) below
          .Sort Key1:=.Cells(1, LC + 1), Order1:=xlAscending, Header:=xlNo
          
          'We counted how many rows to delete above so just resize the area we are working with
          'to that many rows and delete them. This also deletes all the "1" values from the tmp column
          'leaving nothing in that column that requires cleaning up
          .Resize(rws).EntireRow.Delete
          
      End With
      
      'Turn screen updating back on to see the results
      Application.ScreenUpdating = True
  End If
End Sub