The code for the bracket function is below.
Code:
'---------------------------------------------------------------------------------------
'
' P U R P O S E
'
' The function bracket find x1=x(i1) and x2=x(i2) from a table x
' so that x1 <= x_value <= x2.
'
' I N P U T
'
' x = a range of cells representing x.
' x_value = the x value to be bracketed.
' active = an array of x.count elements.
' = 0 if the corresponding x is to be ignored.
'
' O U T P U T
'
' i1 = the x index which will enclose x_value.
' i2 = the x index which will enclose x_value.
' x(i1) <= x_value <= x(i2)
' If x_value is out-of-bound, the two closest x values to x_value
' will be returned.
' If there are identical values of x(i1) or x(i2) in x, the first one
' encountered will be used.
'
'---------------------------------------------------------------------------------------
Sub bracket(x As Object, x_value, i1, i2, active() As Boolean)
Dim i As Integer ' counter.
Dim x1, xi, x2 As Single ' = x(i1), x(i), x(i2), respectively.
Dim nactive As Integer
Dim usable As Boolean
nactive = UBound(active)
' If dx of first pair of x times number of points matches the last x,
' the program assumes x is equally spaced.
If x.count >= 2 And nactive <= 1 Then
If Abs((x(x.count) - x(1)) / (x.count - 1) - (x(2) - x(1))) <= 0.01 * Abs(x(2) - x(1)) Then
If x(x.count) >= x(1) Then
i1 = Int((x_value - x(1)) / (x(2) - x(1))) + 1
If x_value < x(i1) Then ' Minor adjustment in case of round-off error.
i1 = i1 - 1
End If
If i1 < 1 Then
i1 = 1
ElseIf i1 > x.count - 1 Then
i1 = x.count - 1
End If
i2 = i1 + 1
Else
i1 = x.count - Int((x_value - x(x.count)) / (x(1) - x(2)))
If x_value < x(i1) Then ' Minor adjustment in case of round-off error.
i1 = i1 + 1
End If
If i1 < 2 Then
i1 = 2
ElseIf i1 > x.count Then
i1 = x.count
End If
i2 = i1 - 1
End If
If x_value >= x(i1) And x_value <= x(i2) Then
Exit Sub
ElseIf x_value < x(i1) And (i1 = 1 Or i1 = x.count) Then
Exit Sub
ElseIf x_value > x(i2) And (i2 = 1 Or i2 = x.count) Then
Exit Sub
End If
End If
End If
' If the above fails, a more thorough search is performed.
i1 = 0
i2 = 0
For i = 1 To x.count
xi = x(i)
If nactive <= 1 Then
usable = True
Else
usable = active(i)
End If
If Not usable Or Not IsNumeric(xi) Or VarType(xi) = vbEmpty Then
' Do nothing.
ElseIf i1 = i2 Then
If i1 = 0 Then
i1 = i
i2 = i
x1 = xi
x2 = xi
ElseIf xi > x2 Then
i2 = i
x2 = xi
ElseIf xi < x1 Then
i1 = i
x1 = xi
End If
ElseIf x1 <= x_value And x2 >= x_value Then
If xi <= x1 Or xi >= x2 Then
' Do nothing.
ElseIf xi < x_value Then
i1 = i
x1 = xi
Else
i2 = i
x2 = xi
End If
ElseIf x1 >= x_value Then
If xi < x1 Then
i2 = i1
x2 = x1
i1 = i
x1 = xi
ElseIf xi <> x1 And xi < x2 Then
i2 = i
x2 = xi
End If
ElseIf x2 <= x_value Then
If xi > x2 Then
i1 = i2
x1 = x2
i2 = i
x2 = xi
ElseIf xi <> x2 And xi > x1 Then
i1 = i
x1 = xi
End If
End If
Next i
End Sub