CODEWITHSUNDEEP
excelexcel-formulaexcel-2010
Viktor Tango
Viktor Tango

Reputation: 453

Optimize Excel Formula that uses large arrays

I have used the below mentioned excel formula.

=INDEX(TABL,SMALL(IF(COUNTIF(H2,$A$1:$A$325779)*COUNTIF(I2,"<="&$B$1:$B$325779),ROW(TABL)-MIN(ROW(TABL))+1),1),3)

Where "TABL",a table, is A1:E325779 and is the source of my lookup array.

The formula mentioned is the exact requirement but is taking a lot of time to update the excel for 400,000+ cells containing this formula.

Can this be optimized? Or can this be equated to a faster macro?

Its taking 1 second to update 1 cell!!! That's a very long time to update all 400K+ cells once!!!

Screenshot of a sample worksheet is as below.

enter image description here

I have based my program on Martin Carlsson's. it is processing 100 records in 30 seconds. can it be improved?

Sub subFindValue()
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Cells(2, 12) = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")

    Dim varRow As Variant
    Dim varRowMain As Variant
    Dim lookupTable As Variant
    Dim lookupValueTable As Variant

    lookupValueTable = Range("G2:J309011").Value
    lookupTable = Range("A2:D325779").Value

    varRowMain = 1
    varRow = 1

    Do Until varRowMain = 309011
        Do Until varRow = 325779
            If lookupTable(varRow, 1) = lookupValueTable(varRowMain, 1) And lookupTable(varRow, 2) >= lookupValueTable(varRowMain, 2) Then
                lookupValueTable(varRowMain, 3) = lookupTable(varRow, 3)
                lookupValueTable(varRowMain, 4) = lookupTable(varRow, 4)
                Exit Do
            End If
            varRow = varRow + 1
        Loop

        If IsEmpty(lookupValueTable(varRowMain, 3)) Then
            lookupValueTable(varRowMain, 3) = "NA_OX"
            lookupValueTable(varRowMain, 4) = "NA_OY"
        End If

        varRowMain = varRowMain + 1
        varRow = 1
    Loop
    Range("G2:J309011").Value = lookupValueTable

    Cells(3, 12) = Format(DateTime.Now, "yyyy-MM-dd hh:mm:ss")

    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

Upvotes: 0

Views: 8461

Answers (4)

user2140261
user2140261

Reputation: 7993

This should work and be much faster then any VBA solution that would require looping every row as long as you can sort the date in Column B Descending:

Enter the following Formula As an Array (Instead of Enter use Ctrl+Shift+Enter

=INDEX($C$1:$C$15,MATCH(G2,IF($A$1:$A$15=F2,$B$1:$B$15),-1))

You should end up with something like:

enter image description here

Explanation:

IF($A$1:$A$15=F2,$B$1:$B$15)

Is building an array of values equal to the rows in column B where The Test word is in the same Row column A. 

MATCH(G2,IF($A$1:$A$15=F2,$B$1:$B$15),-1)

This is using the Array built from the Id statement to find the smallest value greater than or equal to the Look up value from test data. 

=INDEX($C$1:$C$15,MATCH(G2,IF($A$1:$A$15=F2,$B$1:$B$15),-1))

Once it is all together the 'INDEX' will return the value in Column C that is at the same position as the matched value.

UPDATE: If you are looking for what tigeravatar's Answer returns then here is another VBA function that will return all values: 

Sub GetValues()

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

Dim strMetalName As String: strMetalName = [E3]
Dim dbMinimumValue As Double: dbMinimumValue = [F3]

Range("G3:G" & Rows.Count).ClearContents

With Range("TABL")
    .AutoFilter Field:=1, Criteria1:=strMetalName
    .AutoFilter Field:=2, Criteria1:=">=" & dbMinimumValue, Operator:=xlAnd
     Range("C2", [C2].End(xlDown)).Copy [G3]
    .AutoFilter
End With

With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With
End Sub

For me his took 5-7 minutes to run while this took 1.5 seconds, where my first answer returns the single row containing the closest matching result this sub will return ALL values greater then or equal too.

Upvotes: 1

tigeravatar
tigeravatar

Reputation: 26640

You may need to adjust where the output goes (it assumes that the results should be output in cell G3 and down), but this should run pretty quickly:

Sub subFindValue()

    Dim rngFound As Range
    Dim arrResults() As Variant
    Dim varFind As Variant
    Dim dCompare As Double
    Dim ResultIndex As Long
    Dim strFirst As String

    varFind = Range("E3").Text
    dCompare = Range("F3").Value2

    Range("G3:G" & Rows.Count).ClearContents

    With Range("TABL").Resize(, 1)
        Set rngFound = .Find(varFind, .Cells(.Cells.Count), xlValues, xlWhole)
        If Not rngFound Is Nothing Then
            ReDim arrResults(1 To WorksheetFunction.CountIf(.Cells, varFind), 1 To 1)
            strFirst = rngFound.Address
            Do
                If rngFound.Offset(, 1).Value > dCompare Then
                    ResultIndex = ResultIndex + 1
                    arrResults(ResultIndex, 1) = rngFound.Offset(, 2).Text
                End If
                Set rngFound = .Find(varFind, rngFound, xlValues, xlWhole)
            Loop While rngFound.Address <> strFirst
        End If
    End With

    If ResultIndex > 0 Then Range("G3").Resize(ResultIndex).Value = arrResults

End Sub

Upvotes: 1

Charles Williams
Charles Williams

Reputation: 23505

If your data is sorted on column 2 within column 1 then the SpeedTools Filter.Ifs function would be considerable faster than your formula (at least 50 times faster)

=FILTER.IFS(2,$A$1:$C$325779,3,1,E3,2,">" & F3)


Disclaimer: I am the author of SpeedTools which is a commercial Excel addin product.
You can download a full trial version from:
http://www.decisionmodels.com/FastExcelV3SpeedTools.htm

Upvotes: 1

Martin Carlsson
Martin Carlsson

Reputation: 471

Is this what you need?

Sub subFindValue()
    'Speed up
    Application.ScreenUpdating = False
    Application.DisplayStatusBar = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    Dim strNamedValue As String: strNamedValue = Range("E3")
    Dim curHigherThanValue As Currency: curHigherThanValue = Range("F3")
    Dim varRow As Variant

    varRow = 1
    Do Until IsEmpty(Cells(varRow, 1))
        If Cells(varRow, 1) = strNamedValue And Cells(varRow, 2) > curHigherThanValue Then
            Range("G3") = Cells(varRow, 3)
            Exit Do
        End If
        varRow = varRow + 1
        Loop

    'Slow down
    Application.ScreenUpdating = True
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    End Sub

Upvotes: 2

Related Questions