From KeepITCool
Function kicCeiling(ByVal vNum As Variant, ByVal vSig As Variant) As Variant
Dim vRes
Dim r&, c&
Dim n&, nrL&, nrU&, ncL&, ncU&
Dim s&, srL&, srU&, scL&, scU&
On Error Resume Next
If TypeName(vNum) = “Range” Then vNum = vNum.Value
nrU = -1: ncU = -1
nrL = LBound(vNum, 1): nrU = UBound(vNum, 1)
ncL = LBound(vNum, 2): ncU = UBound(vNum, 2)
If ncU > -1 Then n = 2 Else If nrU > -1 Then n = 1 Else n = 0
If TypeName(vSig) = “Range” Then vSig = vSig.Value
srU = -1: scU = -1
srL = LBound(vSig, 1): srU = UBound(vSig, 1)
scL = LBound(vSig, 2): scU = UBound(vSig, 2)
If scU > -1 Then s = 2 Else If srU > -1 Then s = 1
Select Case n & s
Case “00”
vRes = GetCeiling(vNum, vSig)
Case “20”
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig): Next: Next
Case “02”
ReDim vRes(srL To srU, scL To scU)
For r = srL To srU: For c = scL To scU: vRes(r, c) = GetCeiling(vNum, vSig(r, c)): Next: Next
Case “22”
Debug.Assert nrL = srL And ncL = scL
If nrU = srU And ncU = scU Then
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c)): Next: Next
ElseIf nrU = 1 Then
ReDim vRes(srL To srU, ncL To ncU)
For r = srL To srU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(1, c), vSig(r, 1)): Next: Next
ElseIf srU = 1 Then
ReDim vRes(nrL To nrU, scL To scU)
For r = nrL To nrU: For c = scL To scU: vRes(r, c) = GetCeiling(vNum(r, 1), vSig(1, c)): Next: Next
Else
nrU = Application.Max(nrU, srU)
ncU = Application.Max(ncU, scU)
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU
If r < = UBound(vNum, 1) And r <= UBound(vSig, 1) Then
For c = ncL To ncU
If c <= UBound(vNum, 2) And c <= UBound(vSig, 2) Then
vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c))
Else
vRes(r, c) = CVErr(xlErrNA)
End If
Next
Else
For c = ncL To ncU
vRes(r, c) = CVErr(xlErrNA)
Next
End If
Next
End If
Case “10”
ReDim vRes(nrL To nrU)
For r = nrL To nrU: vRes(r) = GetCeiling(vNum(r), vSig): Next
Case “01”
ReDim vRes(srL To srU)
For r = srL To srU: vRes(r) = GetCeiling(vNum, vSig(r)): Next
Case “11”
Debug.Assert nrL = srL And nrU = srU
ReDim vRes(nrL To nrU)
For r = nrL To nrU: vRes(r) = GetCeiling(vNum(r), vSig(r)): Next
Case “21”
Debug.Assert ncU = 1
ReDim vRes(nrL To nrU, srL To srU)
For r = nrL To nrU: For c = srL To srU: vRes(r, c) = GetCeiling(vNum(r, 1), vSig(c)): Next: Next
Case “12”
Debug.Assert scU = 1
ReDim vRes(srL To srU, nrL To nrU)
For r = srL To srU: For c = nrL To nrU: vRes(r, c) = GetCeiling(vNum(c), vSig(r, 1)): Next: Next
End Select
kicCeiling = vRes
End Function
Private Function GetCeiling(ByVal number As Variant, ByVal significance As Variant) As Variant
Dim dNum#, dSig#, dTmp#
Dim vRes
On Error GoTo errH
Select Case VarType(number) ‘+vbArray will error out.
Case vbError: vRes = number: GoTo endH
Case vbBoolean: dNum = Abs(number)
Case Else: dNum = number
End Select
Select Case VarType(significance)
Case vbError: vRes = significance: GoTo endH
Case vbBoolean: dSig = Abs(significance)
Case Else: dSig = significance
End Select
If dNum = 0 Or dSig = 0 Then
vRes = 0#
ElseIf Sgn(dNum) <> Sgn(dSig) Then
vRes = CVErr(xlErrNum)
Else
dTmp = dNum / dSig
vRes = (Int(dTmp) + Abs(dTmp <> Int(dTmp))) * dSig
End If
endH:
GetCeiling = vRes
Exit Function
errH:
vRes = CVErr(xlErrValue)
GoTo endH:
End Function
Dim vRes
Dim r&, c&
Dim n&, nrL&, nrU&, ncL&, ncU&
Dim s&, srL&, srU&, scL&, scU&
On Error Resume Next
If TypeName(vNum) = “Range” Then vNum = vNum.Value
nrU = -1: ncU = -1
nrL = LBound(vNum, 1): nrU = UBound(vNum, 1)
ncL = LBound(vNum, 2): ncU = UBound(vNum, 2)
If ncU > -1 Then n = 2 Else If nrU > -1 Then n = 1 Else n = 0
If TypeName(vSig) = “Range” Then vSig = vSig.Value
srU = -1: scU = -1
srL = LBound(vSig, 1): srU = UBound(vSig, 1)
scL = LBound(vSig, 2): scU = UBound(vSig, 2)
If scU > -1 Then s = 2 Else If srU > -1 Then s = 1
Select Case n & s
Case “00”
vRes = GetCeiling(vNum, vSig)
Case “20”
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig): Next: Next
Case “02”
ReDim vRes(srL To srU, scL To scU)
For r = srL To srU: For c = scL To scU: vRes(r, c) = GetCeiling(vNum, vSig(r, c)): Next: Next
Case “22”
Debug.Assert nrL = srL And ncL = scL
If nrU = srU And ncU = scU Then
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c)): Next: Next
ElseIf nrU = 1 Then
ReDim vRes(srL To srU, ncL To ncU)
For r = srL To srU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(1, c), vSig(r, 1)): Next: Next
ElseIf srU = 1 Then
ReDim vRes(nrL To nrU, scL To scU)
For r = nrL To nrU: For c = scL To scU: vRes(r, c) = GetCeiling(vNum(r, 1), vSig(1, c)): Next: Next
Else
nrU = Application.Max(nrU, srU)
ncU = Application.Max(ncU, scU)
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU
If r < = UBound(vNum, 1) And r <= UBound(vSig, 1) Then
For c = ncL To ncU
If c <= UBound(vNum, 2) And c <= UBound(vSig, 2) Then
vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c))
Else
vRes(r, c) = CVErr(xlErrNA)
End If
Next
Else
For c = ncL To ncU
vRes(r, c) = CVErr(xlErrNA)
Next
End If
Next
End If
Case “10”
ReDim vRes(nrL To nrU)
For r = nrL To nrU: vRes(r) = GetCeiling(vNum(r), vSig): Next
Case “01”
ReDim vRes(srL To srU)
For r = srL To srU: vRes(r) = GetCeiling(vNum, vSig(r)): Next
Case “11”
Debug.Assert nrL = srL And nrU = srU
ReDim vRes(nrL To nrU)
For r = nrL To nrU: vRes(r) = GetCeiling(vNum(r), vSig(r)): Next
Case “21”
Debug.Assert ncU = 1
ReDim vRes(nrL To nrU, srL To srU)
For r = nrL To nrU: For c = srL To srU: vRes(r, c) = GetCeiling(vNum(r, 1), vSig(c)): Next: Next
Case “12”
Debug.Assert scU = 1
ReDim vRes(srL To srU, nrL To nrU)
For r = srL To srU: For c = nrL To nrU: vRes(r, c) = GetCeiling(vNum(c), vSig(r, 1)): Next: Next
End Select
kicCeiling = vRes
End Function
Private Function GetCeiling(ByVal number As Variant, ByVal significance As Variant) As Variant
Dim dNum#, dSig#, dTmp#
Dim vRes
On Error GoTo errH
Select Case VarType(number) ‘+vbArray will error out.
Case vbError: vRes = number: GoTo endH
Case vbBoolean: dNum = Abs(number)
Case Else: dNum = number
End Select
Select Case VarType(significance)
Case vbError: vRes = significance: GoTo endH
Case vbBoolean: dSig = Abs(significance)
Case Else: dSig = significance
End Select
If dNum = 0 Or dSig = 0 Then
vRes = 0#
ElseIf Sgn(dNum) <> Sgn(dSig) Then
vRes = CVErr(xlErrNum)
Else
dTmp = dNum / dSig
vRes = (Int(dTmp) + Abs(dTmp <> Int(dTmp))) * dSig
End If
endH:
GetCeiling = vRes
Exit Function
errH:
vRes = CVErr(xlErrValue)
GoTo endH:
End Function
I get NA for the array formula
=SUM(kicceiling(A17:B18,E17:E18))
but I haven’t had time to sort out why.
The problem is in Case “22?. Specifically, when vNum is M-by-N and vSig is M-by-1,
If c <&eq; UBound(vNum, 2) And c <&eq; UBound(vSig, 2) Then
The problem is that ncL = 1, ncU = 2, and UBound(vNum, 2) = 2, BUT UBound(vSig, 2) = 1. That means that on the second iteration when c = 2, the second test above fails, which leads to an #N/A entry in the result array.
You made nrU = 1 and scU = 1 special cases. You should also have made ncU = 1 and scU = 1 special cases. But that doesn’t fix things. With {8,7.5;10,10} in D3:E4 and {2,2.5,} in D1:F1,
=kicceiling(D3:E4,D1:F1)
returns {8,10,0;10,10,0} while
=CEILING($D$3:$E$4,$D$1:$F$1)
returns {8,7.5,#N/A;10,10,#N/A}, so you still have a bug in your array iteration AND you have a bug in GetCeiling.
Yep, missed that. Repaired “case 22? as follows:
Debug.Assert nrL = srL And ncL = scL
If nrU = srU And ncU = scU Then
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c)): Next: Next
Else
Dim nrX As Long, srX As Long, ncX As Long, scX As Long
If nrU = 1 Then nrU = srU Else nrX = 1
If srU = 1 Then srU = nrU Else srX = 1
If ncU = 1 Then ncU = scU Else ncX = 1
If scU = 1 Then scU = ncU Else scX = 1
nrU = Application.Max(nrU, srU)
ncU = Application.Max(ncU, scU)
ReDim vRes(nrL To nrU, ncL To ncU)
For r = 0 To nrU – nrL
For c = 0 To ncU – ncL
vRes(nrL + r, ncL + c) = CVErr(xlErrNA)
vRes(nrL + r, ncL + c) = GetCeiling(vNum(nrL + r * nrX, ncL + c * ncX), vSig(srL + r * srX, scL + c * scX))
Next
Next
End If
Remaining challenge
return #Value! for non array-entered arrays, BUT return array in editmode
With Application
If TypeOf .Caller Is Range Then If Not .Caller.HasArray Then vRes = CVErr(xlErrValue)
End With
End If
however return vRes in editmode.. I’ve tried Application.Ready (xp+) but it doens’t work.
Case “22?
Debug.Assert nrL = srL And ncL = scL
If nrU = srU And ncU = scU Then
ReDim vRes(nrL To nrU, ncL To ncU)
For r = nrL To nrU: For c = ncL To ncU: vRes(r, c) = GetCeiling(vNum(r, c), vSig(r, c)): Next: Next
Else
Dim nrX As Long, srX As Long, ncX As Long, scX As Long
If nrU = 1 Then nrU = srU Else nrX = 1
If srU = 1 Then srU = nrU Else srX = 1
If ncU = 1 Then ncU = scU Else ncX = 1
If scU = 1 Then scU = ncU Else scX = 1
nrU = Application.Max(nrU, srU)
ncU = Application.Max(ncU, scU)
ReDim vRes(nrL To nrU, ncL To ncU)
For r = 0 To nrU – nrL
For c = 0 To ncU – ncL
vRes(nrL + r, ncL + c) = CVErr(xlErrNA)
vRes(nrL + r, ncL + c) = GetCeiling(vNum(nrL + r * nrX, ncL + c * ncX), vSig(srL + r * srX, scL + c * scX))
Next
Next
End If