How would I loop this Function over column Q with VBA? - excel

Question

I have the following code and it does what I want it to as far as removing the data I want to remove. The only thing is I have to run it over and over and over for it to get through all of the data. How would I get this to loop over just column q?
Sub SdeleteDeclinesfoReal()
Dim sString As String
Dim MyAr
Dim i As Long
Dim delRange As Range, aCell As Range
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet1")
'~~> Add more to the list here separated by "/"
sString = "Declined/Self ACH"
MyAr = Split(sString, "/")
With ws
For i = LBound(MyAr) To UBound(MyAr)
Set aCell = .Columns(17).Find(What:=MyAr(i), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase :=False, SearchFormat:=False)
If Not aCell Is Nothing Then
If delRange Is Nothing Then
Set delRange = .Rows(aCell.Row)
Else
Set delRange = Union(delRange, .Rows(aCell.Row))
End If
End If
Next i
End With
'...
End Sub

Answer 1

Loop Through Column
A Find Method Solution
Option Explicit
Sub SdeleteDeclinesfoReal()
Const FirstRow As Long = 2
Const CritCol As String = "Q"
Dim Criteria As Variant
'~~> Add more to the list here
Criteria = Array("Declined", "Self ACH")
Dim ws As Worksheet
Dim rng As Range, delRange As Range, aCell As Range
Dim i As Long
Dim sString As String
Dim FirstAddress As String
Set ws = ThisWorkbook.Sheets("Sheet1")
' Define range "Q2:Q1048576" (FirstRow, CritCol).
Set rng = ws.Cells(FirstRow, CritCol).Resize(ws.Rows.Count - FirstRow + 1)
' Define last non-blank cell.
Set rng = rng.Find(What:="*", _
LookIn:=xlValues, _
SearchDirection:=xlPrevious)
If Not rng Is Nothing Then
' Define 'non-blank' range.
Set rng = ws.Cells(FirstRow, CritCol).Resize(rng.Row - FirstRow + 1)
With rng
For i = LBound(Criteria) To UBound(Criteria)
sString = Criteria(i)
Set aCell = .Find(What:=sString, _
LookAt:=xlWhole)
If Not aCell Is Nothing Then
FirstAddress = aCell.Address
Do
If delRange Is Nothing Then
Set delRange = aCell.EntireRow
Else
Set delRange = Union(delRange, aCell.EntireRow)
End If
Set aCell = .FindNext(aCell)
' Prevent infinite loop caused by the 'FindNext' method.
Loop Until aCell.Address = FirstAddress
Else
' Criteria not found.
End If
' Prevent infinite loop when a criteria is found and one
' of the next is not.
Set aCell = Nothing
Next i
End With
If Not delRange Is Nothing Then
delRange.Select ' Test with 'Select'. Later change to 'Delete'.
Else
' Nothing cell found.
End If
Else
' All cells below first row are blank (empty or "").
End If
End Sub
A Reminder Why to Use Union
Copy the examples into a standard module, e.g. Module1 of a new workbook.
The first two procedures show how to increase efficiency using an array, but are primarily here to better understand what the last three procedures do.
Run the trio each after populating the values, and monitor how long they take and look at the ActiveSheet before and after to see the differences.
Test Union
Option Explicit
' Slow
Sub populateValuesSlow()
Const NoR As Long = 5000
Const NoC As Long = 10
Dim i As Long
Dim j As Long
For i = 1 To NoR
For j = 1 To NoC
Cells(i, j) = Int(Rnd() * (10 - 1)) + 1
Next j
Next i
End Sub
' Fast
Sub populateValuesFast()
Const NoR As Long = 5000
Const NoC As Long = 10
Dim i As Long
Dim j As Long
Dim Data As Variant
ReDim Data(1 To NoR, 1 To NoC)
For i = 1 To NoR
For j = 1 To NoC
Data(i, j) = Int(Rnd() * (10 - 1)) + 1
Next j
Next i
Cells(1, 1).Resize(UBound(Data, 1), UBound(Data, 2)).Value = Data
End Sub
' Wrong: in this case, half of the data still remains.
Sub deleteRowsOneRowAtTheTimeWrong()
Const NoR As Long = 5000
Dim i As Long
For i = 1 To NoR
Rows(i).Delete
Next i
End Sub
' Right but Slow
Sub deleteRowsOneRowAtTheTime()
Const NoR As Long = 5000
Dim i As Long
For i = NoR To 1 Step -1
Rows(i).Delete
Next i
End Sub
' Right and Fast
Sub deleteRowsWithUnion()
Const NoR As Long = 5000
Dim rng As Range
Dim i As Long
For i = 1 To NoR
If Not rng Is Nothing Then
Set rng = Union(rng, Rows(i))
Else
Set rng = Rows(i)
End If
Next i
rng.Delete
End Sub

Answer 2

Well let me describe your scenary:
You have a list in this case your list is
sString = "Declined/Self ACH" (for this example your list have 2 elements)
then you have a table that have at least 17 columns ( Set aCell = .Columns(17).Find) and with your program you search all rows that have in column 17 a value that is in your list then put all that "rows" in a range (delRange) and delete all rows in that range
In this point your code only find firts match for each element in your list so you Range (delRange) have maximum size equal maximum size your list (for this example 2).
OK for me:
Why you save a range with elements that you are going to delete?
you can insert a delete instruction in second loop that others user suggest you, but instead use .Findnext you use another .find
PO=17 /*PO is whatever column you want*/
For i = LBound(MyAr) To UBound(MyAr)
Set aCell = .Columns(PO).Find(What:=MyAr(i), LookIn:=xlValues)
If Not aCell Is Nothing Then
Do
.Rows(aCell.Row).Delete
Set aCell = .Columns(PO).Find(What:=MyAr(i), LookIn:=xlValues)
Loop While Not aCell Is Nothing
End If
Next i