Using Excel VBA to get min and max based on criteria - excel

Question

I am trying to get the earliest start date (min) and the furthest end date (max) based on criteria in a source column. I have created several functions based on a solution I found on the internet. I have also tried an array formula solution without using VBA. Neither of the approaches have worked. I have found similar questions/answers on SO but none that correctly apply to my situation.
In my example below I have a Task worksheet and an Export worksheet. The Export worksheet is the source data. In the Task worksheet I am trying to enter a formula that finds the minimum start date. Each Task ID can have several dates so I am trying to find the lowest and highest start dates for each of the tasks. I originally tried using an array formula but ran into the same problem which is that sometimes the formula produces the correct answer and sometimes it gives an incorrect answer and I cannot locate the source of the issue. Any help is much appreciated!
VBA Functions:
Function getmaxvalue(Maximum_range As Range)
Dim i As Double
For Each cell In Maximum_range
If cell.Value > i Then
i = cell.Value
End If
Next
getmaxvalue = i
End Function
Function getminvalue(Minimum_range As Range)
Dim i As Double
i = getmaxvalue(Minimum_range)
For Each cell In Minimum_range
If cell.Value < i Then
i = cell.Value
End If
Next
getminvalue = i
End Function
Function GetMinIf(SearchRange As Range, SearchValue As String, MinRange As Range)
Dim Position As Double
Position = 1
Dim getminvalue As Double
getminvalue = MinRange.Rows(1).Value
For Each cell In SearchRange
If LCase(SearchValue) = LCase(cell.Value) And MinRange.Rows(Position).Value < getminvalue Then
getminvalue = MinRange.Rows(Position).Value
End If
Position = Position + 1
Next
GetMinIf = getminvalue
End Function
Function GetMaxIf(SearchRange As Range, SearchValue As String, MaxRange As Range)
Dim Position As Double
Position = 1
Dim getmaxvalue As Double
For Each cell In SearchRange
If LCase(SearchValue) = LCase(cell.Value) And MaxRange.Rows(Position).Value > getmaxvalue Then
getmaxvalue = MaxRange.Rows(Position).Value
End If
Position = Position + 1
Next
GetMaxIf = getmaxvalue
End Function

Answer 1

The issue is that you are trying to equate positions incorrectly. Use this for the MinIf, it no longer needs the secondary function:
Function GetMinIf(SearchRange As Range, SearchValue As String, MinRange As Range)
Dim srArr As Variant
srArr = Intersect(SearchRange.Parent.UsedRange, SearchRange).Value
Dim mrArray As Variant
mrarr = Intersect(MinRange.Parent.UsedRange, MinRange).Value
Dim minTemp As Double
minTemp = 9999999999#
Dim i As Long
For i = 1 To UBound(srArr, 1)
If LCase(SearchValue) = LCase(srArr(i, 1)) And mrarr(i, 1) < minTemp Then
minTemp = mrarr(i, 1)
End If
Next i
GetMinIf = minTemp
End Function
Max:
Function GetMaxIf(SearchRange As Range, SearchValue As String, MaxRange As Range)
Dim srArr As Variant
srArr = Intersect(SearchRange.Parent.UsedRange, SearchRange).Value
Dim mrArray As Variant
mrarr = Intersect(MaxRange.Parent.UsedRange, MaxRange).Value
Dim maxTemp As Double
maxTemp = 0
Dim i As Long
For i = 1 To UBound(srArr, 1)
If LCase(SearchValue) = LCase(srArr(i, 1)) And mrarr(i, 1) > maxTemp Then
maxTemp = mrarr(i, 1)
End If
Next i
GetMaxIf = maxTemp
End Function
As far as formula go IF you have OFFICE 365 then use MINIFS
=MINIFS(Export!F:F,Export!A:A,A2)
=MAXIFS(Export!G:G,Export!A:A,A2)
If not use AGGREGATE:
=AGGREGATE(15,7,Export!$F$2:F$26/(Export!$A$2:A$26=A2),1)
=AGGREGATE(14,7,Export!$G$2:G$26/(Export!$A$2:A$26=A2),1)

Answer 2

I was trying to use Scott's method as part of a macro to transform an invoice. However, the rows of the invoice fluctuate every month and could grow to as many as a million in the future. Anyway, the bottomline is that I had to write the formula in a way where I could make the last row dynamic, which made the macro go from taking 10-15 minutes (by hardcoding a static last row like 1048576 to run to ~ 1 minute to run. I reference this thread to get the idea for the MINIFS workaround and another thread to figure out how to do a dynamic last row. Make vba excel function dynamic with the reference cells
I'm sure there are other methods, perhaps using offset, etc. but I tried other methods and this one was pretty quick. Anyone can use this VBA formula if they do the following:
15 to 14 to do a maxifs, keep as is for minifs
change the relevant rows and columns in Cells(rows, columns) format below.
The True/False parameters passed to .Address() will lock/unlock the rows/columns respectively (i.e. add a $ in front if True).
Change the last row
First, get the last row
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Second, here is the dynamic minifs
Range("F2").Formula = "=AGGREGATE(15,7," & Range(Cells(2, 6), Cells(LastRow, 6)).Address(True, True) & "/(" & Range(Cells(2, 1), Cells(LastRow, 1)).Address(True, True) & "=" & Range(Cells(2, 1), Cells(2, 1)).Address(False, True) & "),1)"
Third, autofill down.
Range("F2").AutoFill Destination:=Range("F2:F" & LastRow)