Delete on multiple criteria (VBA Variable controlled)

[applebyd]

Hi all,

Nearly finished the current project and have one final hurdle.
I have just spent time going through the prior threads and cannot find what I'm after.

I have the code below and am fairly certain this is the long winded and inefficient way to attack the problem.


What I need to do is check the value of Column AT and return one of three values Master, Competent or Foundation. It then needs to delete any rows containing Master in Col AT where Col AV is greater than the value of the Variable Master (which is fed from a cell value in the Controls sheet. It then needs to do the same for Competent and Foundation in AT.

Any suggestions welcome (or more probably a point at a thread I missed!)

<CODE>
Sheets("Sample").Select
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False



Dim Master As Long
Dim Competent As Long
Dim Foundation As Long

Master = Worksheets("Controls").Cells(40, "H").Value
Competent = Worksheets("Controls").Cells(40, "I").Value
Foundation = Worksheets("Controls").Cells(40, "J").Value

Dim i As Long

i = 1

Do While i <= ThisWorkbook.ActiveSheet.Range("AV1").CurrentRegion.Rows.Count

If InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Value) > Master And ThisWorkbook.ActiveSheet.Range("AT1") = Master Then
ThisWorkbook.ActiveSheet.Cells(i, 1).EntireRow.Delete
Else
i = i + 1
End If

Loop

Dim j As Long

j = 1

Do While j <= ThisWorkbook.ActiveSheet.Range("AV1").CurrentRegion.Rows.Count

If InStr(1, ThisWorkbook.ActiveSheet.Cells(j, 1).Value) > Competent And ThisWorkbook.ActiveSheet.Range("AT1") = Competent Then
ThisWorkbook.ActiveSheet.Cells(j, 1).EntireRow.Delete
Else
j = j + 1
End If

Loop


Dim k As Long

k = 1

Do While k <= ThisWorkbook.ActiveSheet.Range("AV1").CurrentRegion.Rows.Count

If InStr(1, ThisWorkbook.ActiveSheet.Cells(k, 1).Value) > Foundation And ThisWorkbook.ActiveSheet.Range("AT1") = Foundation Then
ThisWorkbook.ActiveSheet.Cells(k, 1).EntireRow.Delete
Else
k = k + 1
End If

Loop


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = False

</CODE>


Regards

DaveA

 

[steve the fish]

Im a bit confused. What is the instr for? Also how can cell AT1 equal all three of your variables (unless they are all the same)?

 

[applebyd]

Thanks Steve.

The INSTR code was pinched from another thread on MrExcel and seems to work up to a point.

Column AT is populated for all rows and will contain one of the three terms (Master, Competent or Foundation)
What happens is I have a COUNTIF that counts Agent ID's and sets the variables (Again, Master, Competent and Foundation)
and need to delete any rows where say it says Master in Col:AT and Count > than the variable Master. Same for Competent and Foundation.

Hope this explains things a bit better.

The code works right until I add the AND to the delete rows line if it helps.

Regards

DaveA

 

[Fluff]

Added to what @steve the fish has said.
Does col AT contain the words Master, Competent & Foundation, or does it contain the Values held in the Control sheet?

 

[steve the fish]

I think im right in saying this:

<code>If InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Value) > Master</code>

is almost never true because it is searching for the string in cells(i,1) in "1" and returning its position. It can only return 1 or 0 in this case. 1 if cells(i,1) = 1 and 0 if it doesnt. So the If is asking if 0 > Master unless cells(i,1) = 1 where its asking if 1 > Master. I doubt this is as intended.

 

[Fluff]

Try this for Master

Sub Fluff()
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Dim i As Long
    Dim Master As Long
    Dim Competent As Long
    Dim Foundation As Long
    
    Master = Worksheets("Controls").Cells(40, "H").Value
    Competent = Worksheets("Controls").Cells(40, "I").Value
    Foundation = Worksheets("Controls").Cells(40, "J").Value
    Sheets("Sample").Select
    
    For i = Range("AV1").CurrentRegion.Rows.Count To 1 Step -1
        If Range("AV" & i).Value > Master And UCase(Range("AT" & i).Value) = "MASTER" Then
            Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub

If this works as expected, we can modify it for the other 2 criteria

 

[applebyd]

Try this for Master

Sub Fluff()
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Dim i As Long
    Dim Master As Long
    Dim Competent As Long
    Dim Foundation As Long
    
    Master = Worksheets("Controls").Cells(40, "H").Value
    Competent = Worksheets("Controls").Cells(40, "I").Value
    Foundation = Worksheets("Controls").Cells(40, "J").Value
    Sheets("Sample").Select
    
    For i = Range("AV1").CurrentRegion.Rows.Count To 1 Step -1
        If Range("AV" & i).Value > Master And UCase(Range("AT" & i).Value) = "MASTER" Then
            Range("A" & i).EntireRow.Delete
        End If
    Next i
End Sub

If this works as expected, we can modify it for the other 2 criteria

Thanks Fluff.

You are correct that col AT contains the word Master, Competent or Foundation.

I will give the code a run in the morning and let you know.

Just to reiterate.

If AT equals Master then we need to delete any row whete the value in AV is higher than the variable Master.

Thanks for all the help.

Regards

DaveA

 

[applebyd]

Fluff,

Worked a treat, I've cloned it for the other two variables and that's working fine too.

I've been out of the Excel business for a few years and am breaking myself back in!

I'm going to have to explain to someone why the routine is called Sub Fluff() but I'm not changing the name!

I've got the same thing to do with another sheet and six variables instead of the three here.

Can you think of an easy way rather than running six loops?

Please don't spend anytime on it, you've done enough already.

Many many thanks.

Regards

DaveA

 

[steve the fish]

See if you can see what this loop within a loop is doing and changing it to suit:

Sub Fluff()

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

Dim i As Long, a As Long
Dim arr(0 To 2, 0 To 1)

arr(0, 0) = "Master": arr(0, 1) = Worksheets("Controls").Cells(40, "H").Value
arr(1, 0) = "Competent": arr(1, 1) = Worksheets("Controls").Cells(40, "I").Value
arr(2, 0) = "Foundation": arr(2, 1) = Worksheets("Controls").Cells(40, "J").Value

Sheets("Sample").Select
    
For a = LBound(arr) To UBound(arr)
    For i = Range("AV1").CurrentRegion.Rows.Count To 1 Step -1
        If Range("AV" & i).Value > arr(a, 1) And UCase(Range("AT" & i).Value) = UCase(arr(a, 0)) Then
            Range("A" & i).EntireRow.Delete
        End If
    Next i
Next a
    
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
End With

End Sub

 

[Fluff]

Another option is to use a select case statement

Sub Fluff()
    
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    
    Dim i As Long
    Dim Master As Long
    Dim Competent As Long
    Dim Foundation As Long
    Dim Rng As Range
    
    Master = Worksheets("Controls").Cells(40, "H").Value
    Competent = Worksheets("Controls").Cells(40, "I").Value
    Foundation = Worksheets("Controls").Cells(40, "J").Value
    Sheets("Sample").Select
    
    For i = Range("AV1").CurrentRegion.Rows.Count To 1 Step -1
        Select Case UCase(Range("AT" & i).Value)
            Case "MASTER"
                If Range("AV" & i).Value > Master Then
                    If Rng Is Nothing Then
                        Set Rng = Range("A" & i)
                    Else
                        Set Rng = Union(Rng, Range("A" & i))
                    End If
                End If
            Case "COMPETENT"
                If Range("AV" & i).Value > Competent Then
                    If Rng Is Nothing Then
                        Set Rng = Range("A" & i)
                    Else
                        Set Rng = Union(Rng, Range("A" & i))
                    End If
                End If
            Case "FOUNDATION"
                If Range("AV" & i).Value > Foundation Then
                    If Rng Is Nothing Then
                        Set Rng = Range("A" & i)
                    Else
                        Set Rng = Union(Rng, Range("A" & i))
                    End If
                End If
        End Select
    Next i
    Rng.EntireRow.Delete
End Sub