I need to evaluate one of three cases quickly across a large range.

[RockandGrohl]

Hi guys,

Not sure if there exists a much faster way, or even whether using case statements would work faster, but in a list I am trying to go down cell by cell and insert a value based on criteria, as below:

Range("AG2").Activate
Do Until Cells(ActiveCell.Row, "A").Value = ""

    If Cells(ActiveCell.Row, "AH").Value <> "" Then
    ' is Exclusive
    ActiveCell.Value = "EXC-" & ActiveCell.Offset(0, 1).Value
    End If
    
    If Cells(ActiveCell.Row, "AH").Value = "" And Cells(ActiveCell.Row, "AI").Value <> "" Then
    ' is Multi
    ActiveCell.Value = "MUL-" & ActiveCell.Offset(0, 2).Value
    End If
    
    If Cells(ActiveCell.Row, "AH").Value = "" And Cells(ActiveCell.Row, "AI").Value = "" Then
    ' is Enquiry
    ActiveCell.FormulaR1C1 = "=INDEX(R1C42:R1C47,MATCH(MAX(RC42:RC47),RC42:RC47,0))"
    cat = ActiveCell.Value
    ActiveCell.Value = "ENQ-" & Mid(cat, 5)
    End If


ActiveCell.Offset(1, 0).Activate
Loop

Trouble is it takes a few minutes to do 1,000 rows and I can have 90,000 rows to evaluate one by one.

I suppose I can filter to where AH is not blank and then apply the value to each line.

If I look at a For Each within an autofilter, I'm a bit stuck on the Enquiry bit, how do I find the largest number of enquiries, then match it to a header it corresponds to, within this loop?

' Add in customer type

Dim cl As Range
Dim rng As Range
Set rng = Range("AG2:AG" & LastrowDF)

' Exclusive
Range("A1:BC" & LastrowDF).AutoFilter Field:=34, Criteria1:="<>"

For Each cl In rng.SpecialCells(xlCellTypeVisible)
    With cl
    .Value = "EXC-" & cl.Offset(0, 1).Value
    End With
Next cl

On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0

' Multi
Range("A1:BC" & LastrowDF).AutoFilter Field:=34, Criteria1:=""
Range("A1:BC" & LastrowDF).AutoFilter Field:=35, Criteria1:="<>"

For Each cl In rng.SpecialCells(xlCellTypeVisible)
    With cl
    .Value = "MUL-" & cl.Offset(0, 2).Value
    End With
Next cl

On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0

' Enquiry
Range("A1:BC" & LastrowDF).AutoFilter Field:=34, Criteria1:=""
Range("A1:BC" & LastrowDF).AutoFilter Field:=35, Criteria1:=""

For Each cl In rng.SpecialCells(xlCellTypeVisible)
    With cl
    'Application.WorksheetFunction.Index(Sheets("Workers List").Range("C3:C13"), Application.WorksheetFunction.Match(1, Sheets("Workers List").Range("D3:D13"), 0), 1)
    .Value = "ENQ-" & WorksheetFunction.Index(Range("AP1:AU1"), WorksheetFunction.Match(WorksheetFunction.Max(Range("AP" & ActiveCell.Row & ":AU" & ActiveCell.Row), Range("AP" & ActiveCell.Row & ":AU" & ActiveCell.Row), 0)))
    
    End With
Next cl

On Error Resume Next
ActiveSheet.ShowAllData
On Error GoTo 0

What I'm trying to perform VBA wise is essentially this:

"=INDEX(R1C42:R1C47,MATCH(MAX(RC42:RC47),RC42:RC47,0))"

Cheers!

 

[Joe4]

Regarding your first block of code, loops, by their very nature, are a bit inefficient. But if you have to use them, there are a few things you can do to help speed them along:
1. Disable screen updating while the loop is running, and then re-enable at the end after it has finished. This is actually good advice for ANY VBA code that is updating cells. Suppressing all screen updates until the end stops screen flickering and speeds up your code.
2. Avoid selecting cells with ".Select" or ".Activate" statements. This really slows down the code, and their is usually not a need to do this. You do not need to select cells to work with them!

Based on those two things, the first block of code could be rewritten like this, and should be a bit faster to run:

    Dim lr As Long
    Dim r As Long
    Dim cat
 
    Application.ScreenUpdating = False
 
'   Find last cell in column AG with data
    lr = Cells(Rows.Count, "AG").End(xlUp).Row

'   Loop through all rows
    For r = 2 To lr

        If Cells(r, "AH").Value <> "" Then
            ' is Exclusive
            Cells(r, "AG").Value = "EXC-" & Cells(r, "AH").Value
        End If
 
        If Cells(r, "AH").Value = "" And Cells(r, "AI") <> "" Then
            ' is Multi
            Cells(r, "AG").Value = "MUL-" & Cells(r, "AI").Value
         End If
 
        If Cells(r, "AH").Value = "" And Cells(r, "AI").Value = "" Then
            ' is Enquiry
            Cells(r, "AG") = "=INDEX(R1C42:R1C47,MATCH(MAX(RC42:RC47),RC42:RC47,0))"
            cat = Cells(r, "AG")
            Cells(r, "AG") = "ENQ-" & Mid(cat, 5)
        End If

    Next r

    Application.ScreenUpdating = True

Now, if you can avoid loops altogether, that is the most efficient. But I really cannot analyze your whole situation to make that determination.
Just showing you how you can improve your current loop.

 

[RockandGrohl]

Hi Joe,

Sorry, I do typically only show snippets of my code as often the whole procedure is large and extraneous to the problem at hand. I do make a habit of turning screen updating off every time I start a new module or procedure.

I actually solved it really quickly by nesting a load of If statements in to each other, like this:

=IF(AH2<>"","EXC-"&AH2,IF(AH2="",IF(AI2<>"","MUL-"&AI2,"ENQ-"&MID(INDEX($AP$1:$AU$1,MATCH(MAX($AP2:$AU2),$AP2:$AU2,0)),5,10))))

This calculates 26,000 rows basically instantly. I've just tried the supplied code (loop without do, so I changed it for "next" and it worked) and it calculates at the same speed as the old one.

A weird situation where Excel formulas can do what VBA can't! Thanks anyway.

 

[Joe4]

I've just tried the supplied code (loop without do, so I changed it for "next" and it worked)

Sorry, I forgot to change that. I went back and fixed it.

it calculates at the same speed as the old one.

Interesting. I wouldn't have thought that, if you copied all my code in its entirety.
Even so, please take note of the tips I gave you when writing loops in the future.
Some big tips to help speed up your code include:
1. Avoid loops if at all possible
2. Avoid selecting/activating cells, where possible
3. Disable ScreenUpdating (and maybe Calculations) until the end of your code.

A weird situation where Excel formulas can do what VBA can't!

I would caution about coming to that conclusion. Just because this code you tried using in VBA was slower than the Excel formula does NOT mean that VBA cannot do it as efficiently or more efficiently than a formula - it simply means that the method we tried in VBA was slower (and does NOT mean that there aren't other ways to do it in VBA which may be just as fast or faster).

That being said, Excel functions are generally pretty efficient, in most cases. So if there is a way to do it with simple Excel functions, then that is often an efficient (if not the most efficient) way. I have often seen people try to recreate a fairly simple/straightforward Excel function using VBA, and there is often very little to gain by doing so. And with "Application.Worksheetfunction...", you can actually use a lot of Excel functions that do not have VBA equivalents right in VBA.

 

[Ryanms]

I know you said you already found your solution, however I might recommend using ElseIf statements rather than 3 separate If statements. VBA is checking each and every line 3 separate times, even if the first criteria was already met. With the way your code is set up, if the line meets one of the criteria, it couldn't possibly meet the other two, so those two additional checks are irrelevant.

So for that section, it might look something like this:

        If Cells(r, "AH").Value <> "" Then
            ' is Exclusive
            Cells(r, "AG").Value = "EXC-" & Cells(r, "AH").Value
        ElseIf Cells(r, "AH").Value = "" And Cells(r, "AI") <> "" Then
            ' is Multi
            Cells(r, "AG").Value = "MUL-" & Cells(r, "AI").Value
        ElseIf Cells(r, "AH").Value = "" And Cells(r, "AI").Value = "" Then
            ' is Enquiry
            Cells(r, "AG") = "=INDEX(R1C42:R1C47,MATCH(MAX(RC42:RC47),RC42:RC47,0))"
            cat = Cells(r, "AG")
            Cells(r, "AG") = "ENQ-" & Mid(cat, 5)
        End If

I would also recommend defining what "cat" is (Integer, String, etc) as simply declaring a variable without telling Excel what you're declaring it as does take up more bytes as Excel must prepare that variable for any possible input. (It's possible you have already done this in your own code, as the declarations were not included in your original post, but just wanted to put that out there ?)