Function - array with 2 variants

[Bhupinder Rayat]

HI all,

I want to write a function that takes an array with 2 optional values (e.g
op1 and op2) and returns an array with each value less than op2 replaced by
the op2 value, and each value higher than the op1 replaced by the op1 value.

Can anyone help?

Thanks in advance.

ss

 

[Bernie Deitrick]

ss,

Give the code below a try.

HTH,
Bernie
MS Excel MVP

Sub test()
Dim myArr(1 To 10) As Integer
Dim i As Integer
For i = 1 To 10
myArr(i) = i
Next i

'How to replace both upper and lower
ArrReplace myArr, 7, 3

For i = 1 To 10
If myArr(i) <> i Then
MsgBox "When changing both, " & i & " was changed to " & myArr(i)
End If
Next i

'Reset Array
For i = 1 To 10
myArr(i) = i
Next i

'Reset just upper
ArrReplace myArr, 7

For i = 1 To 10
If myArr(i) <> i Then
MsgBox "When changing upper, " & i & " was changed to " & myArr(i)
End If
Next i

'Reset Array
For i = 1 To 10
myArr(i) = i
Next i

'Reset just lower
ArrReplace myArr, , 3

For i = 1 To 10
If myArr(i) <> i Then
MsgBox "When changing lower, " & i & " was changed to " & myArr(i)
End If
Next i

End Sub

Function ArrReplace(ByRef myVArr As Variant, _
Optional op1 As Variant, _
Optional op2 As Variant) As Variant
Dim i As Integer
For i = LBound(myVArr) To UBound(myVArr)
If Not IsMissing(op1) Then If myVArr(i) > op1 Then myVArr(i) = op1
If Not IsMissing(op2) Then If myVArr(i) < op2 Then myVArr(i) = op2
Next i
End Function

 

[Chip Pearson]

Try something like the following. Your requirement that the Op1 and Op2
values are optional makes the code considerably longer than if those
parameters are not optional.

Function Test(InArr() As Variant, _
Optional Op1 As Variant, _
Optional Op2 As Variant) As Variant()
Dim OutArr() As Variant
Dim N As Long
ReDim OutArr(LBound(InArr) To UBound(InArr))
If IsMissing(Op1) = False Then
If IsNumeric(Op1) = False Then
Test = Array(CVErr(xlErrNum)) '#NUM error
Exit Function
End If
Else
'<<<< What to do if Op1 is omitted????
End If
If IsMissing(Op2) = False Then
If IsNumeric(Op2) = False Then
If IsNumeric(Op2) = False Then
Test = Array(CVErr(xlErrNum)) ' #NUM error
Exit Function
End If
End If
Else
'<<<< What to do if Op2 is omitted????
End If

For N = LBound(InArr) To UBound(InArr)
If IsMissing(Op1) = True Then
If IsMissing(Op2) = True Then
OutArr(N) = InArr(N)
Else
If InArr(N) < Op2 Then
OutArr(N) = Op2
Else
OutArr(N) = InArr(N)
End If
End If
Else
If IsMissing(Op2) = True Then
If InArr(N) > Op1 Then
OutArr(N) = Op1
Else
OutArr(N) = InArr(N)
End If
Else
If InArr(N) > Op1 Then
OutArr(N) = Op1
Else
If InArr(N) < Op2 Then
OutArr(N) = Op2
Else
OutArr(N) = InArr(N)
End If
End If
End If
End If
Next N
Test = OutArr
End Function


You can then call the Test function with code like the following:

Sub AAA()
Dim Arr(1 To 4) As Variant
Dim N As Long
Dim Op1 As Variant
Dim Op2 As Variant

Dim V() As Variant
Arr(1) = 10
Arr(2) = 5
Arr(3) = 12
Arr(4) = 3

' A(N) > Op1 => Op1
' A(N) < Op2 => Op2
Op1 = 9
Op2 = 5
V = Test(Arr, Op1, Op2)
'V = Test(Arr)
If IsError(V) = True Then
Debug.Print "*** ERROR."
ElseIf IsArray(V) = True Then
For N = LBound(V) To UBound(V)
Debug.Print N, V(N)
Next N
Else
Debug.Print "*** UNEXPECTED RESULT"
End If
End Sub



--
Cordially,
Chip Pearson
Microsoft MVP
Excel Product Group, 1998-2008
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
USA Central Time (GMT -6:00)

 

[Bhupinder Rayat]

Both work great, thanks very much.... ;-)

Try something like the following. Your requirement that the Op1 and Op2
values are optional makes the code considerably longer than if those
parameters are not optional.

Function Test(InArr() As Variant, _
Optional Op1 As Variant, _
Optional Op2 As Variant) As Variant()
Dim OutArr() As Variant
Dim N As Long
ReDim OutArr(LBound(InArr) To UBound(InArr))
If IsMissing(Op1) = False Then
If IsNumeric(Op1) = False Then
Test = Array(CVErr(xlErrNum)) '#NUM error
Exit Function
End If
Else
'<<<< What to do if Op1 is omitted????
End If
If IsMissing(Op2) = False Then
If IsNumeric(Op2) = False Then
If IsNumeric(Op2) = False Then
Test = Array(CVErr(xlErrNum)) ' #NUM error
Exit Function
End If
End If
Else
'<<<< What to do if Op2 is omitted????
End If

For N = LBound(InArr) To UBound(InArr)
If IsMissing(Op1) = True Then
If IsMissing(Op2) = True Then
OutArr(N) = InArr(N)
Else
If InArr(N) < Op2 Then
OutArr(N) = Op2
Else
OutArr(N) = InArr(N)
End If
End If
Else
If IsMissing(Op2) = True Then
If InArr(N) > Op1 Then
OutArr(N) = Op1
Else
OutArr(N) = InArr(N)
End If
Else
If InArr(N) > Op1 Then
OutArr(N) = Op1
Else
If InArr(N) < Op2 Then
OutArr(N) = Op2
Else
OutArr(N) = InArr(N)
End If
End If
End If
End If
Next N
Test = OutArr
End Function


You can then call the Test function with code like the following:

Sub AAA()
Dim Arr(1 To 4) As Variant
Dim N As Long
Dim Op1 As Variant
Dim Op2 As Variant

Dim V() As Variant
Arr(1) = 10
Arr(2) = 5
Arr(3) = 12
Arr(4) = 3

' A(N) > Op1 => Op1
' A(N) < Op2 => Op2
Op1 = 9
Op2 = 5
V = Test(Arr, Op1, Op2)
'V = Test(Arr)
If IsError(V) = True Then
Debug.Print "*** ERROR."
ElseIf IsArray(V) = True Then
For N = LBound(V) To UBound(V)
Debug.Print N, V(N)
Next N
Else
Debug.Print "*** UNEXPECTED RESULT"
End If
End Sub



--
Cordially,
Chip Pearson
Microsoft MVP
Excel Product Group, 1998-2008
Pearson Software Consulting, LLC
www.cpearson.com
(email on web site)
USA Central Time (GMT -6:00)