Okay, the previous VBA function has a few flaws: it doesn’t test for empty cells, and it is rather inefficient when it comes to memory; it stores the results in an array.
For reference, here is the original code:
Public Function LowestCompPer(vRg As Range) As Double
Dim n As Integer
Dim t As Integer
Dim p() As Double
Dim i As Integer
Dim wsf As WorksheetFunction
Dim j As Integer
Dim k As Integer
Set wsf = Excel.WorksheetFunction
n = vRg.Count
t = (n * (n - 1)) / 2
ReDim p(t) As Double
k = 1
For i = 1 To n - 1
For j = i + 1 To n
p(k) = Abs(vRg(i) - vRg(j)) / (wsf.Max(Abs(vRg(i)), Abs(vRg(j))))
k = k + 1
Next j
Next i
Dim min As Integer
min = 1
For i = 1 To t
If p(i) < p(min) Then
min = i
End If
Next i
LowestCompPer = p(min)
End Function
Now we’re going to fix this. Here we go:
Public Function LowestCompPer(vRg As Range) As Double
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim FullCells As New Collection
Dim PerDbl As Double
Dim min As Double
'get a count of how many cells aren't empty
'also keep a collection of cells that aren't empty
'This will kill two birds with one stone: it will allow us
'us to get rid of the triangular number calculation,
'as well as make sure that all cells we're referring to
'actually have values in them.
For i = 1 To vRg.Count
If vRg(i) <> "" Then
FullCells.Add vRg(i)
End If
Next i
'k keeps track of whether or not the first minimum has been calculation.
'0=no, 1=yes
k = 0
For i = 1 To FullCells.Count - 1
For j = i + 1 To FullCells.Count
'PerDbl temporarily stores the results of our comparison formula
PerDbl = Abs(FullCells(i) - FullCells(j)) / _
(Application.WorksheetFunction.Max(Abs(FullCells(i)), _
Abs(FullCells(j))))
'We have to start somewhere. Remember, all percentages will be
'positive
'Since min always start at 0, we have to initialize min
'Once we've done that, though, we don't want to change it
'again unless we've found a smaller number
If k = 0 Then
min = PerDbl
k = 1
ElseIf PerDbl < min Then
min = PerDbl
End If
Next j
Next i
'Never forget to clean up!
Set FullCells = Nothing
LowestCompPer = min
End Function
It may seem strange, but it works. It may seem like we have traded one inefficiency (looping twice) with another (storing full cells in a Collection), but this was necessary to make sure that the entire range is full.
Leave any comments or questions you may have below.
