CEILING Part 3

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

I get NA for the array formula

=SUM(kicceiling(A17:B18,E17:E18))

but I haven’t had time to sort out why.

Posted in Uncategorized

3 thoughts on “CEILING Part 3

  1. The problem is in Case “22?. Specifically, when vNum is M-by-N and vSig is M-by-1,

    For c = ncL To ncU
      If c &lt;&eq; UBound(vNum, 2) And c &lt;&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.

  2. Yep, missed that. Repaired “case 22? as follows:

        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

    Remaining challenge
    return #Value! for non array-entered arrays, BUT return array in editmode

    If IsArray(vRes) Then
        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.

  3. 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

Posting code? Use <pre> tags for VBA and <code> tags for inline.

Leave a Reply

Your email address will not be published. Required fields are marked *