Optimize Excel Formula that uses large arrays - excel

Question

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.
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

Answer 1

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

Answer 2

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:
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.

Answer 3

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

Answer 4

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