xlf EandA series


Array power 2


0. Preliminary


The EXERCISE - complete the following tasks



Task 1

Worksheet setup

  • Tab name: Sheet1
  • B3: 2, C3: 5
  • B4: 3, C4: 6
  • B5: 4, C5: 7

Required
1.1 Write a user defined function (UDF) named ArrPwr2 that takes one argument, a range object, and returns the square (^ 2) of the argument as an array. The function will be called from the worksheet as an array formula (CSE). Assume that the values in the array object are valid numbers.


1.2 Write a test procedure, named TestArrPwr2 to pass the Sheet1!B3:C5 array to the ArrPwr2 UDF, and assign the return value to a variable named Ans of type Variant


Task 2

Requires completion of task 1. Add a label Data1 to Sheet1!B2


Required
Write a sub procedure with the following specifications:


  1. Procedure name: Power2
  2. Procedure scope (explicit): Public
  3. Invoke the Application.Inputbox Method with syntax .InputBox( Prompt , Title , Default , Left , Top , HelpFile , HelpContextID , Type )
  4. Include suitable values for the Prompt, and Title arguments
  5. The Default argument is the CurrentRegion (CR) excluding the header row, conditional on the CR containing all numbers. A single cell <CurrentRegion is permitted
  6. Process the Range with the ArrPwr2 function
  7. Display a second Inputbox to send the output to the range chosen by the User. Allow for the user selecting a multi-cell target of the wrong dimension
  8. Code the Cancel button for each InputBox

 

1.Tasks


Task 1.1: ArrPwr2



Code 1: the ArrPwr2 function interpretation of task 1.1
Option Explicit

'' Solution file to xlf | exercise - range object - array udf - inputbox
'' Source: http://excelatfinance.com/online/topic/xlf-exercise-range-object-array-udf-inputbox/

'' ================================
'' Task 1
'' ================================

Function ArrPwr2(Arr As Range) As Variant
Dim Pwr2Arr() As Double
Dim r As Integer
Dim c As Integer
Dim i As Integer
Dim j As Integer

    r = Arr.Rows.Count
    c = Arr.Columns.Count
    ReDim Pwr2Arr(1 To r, 1 To c)   ' Multi dimensional array

    For i = 1 To r
        For j = 1 To c
            Pwr2Arr(i, j) = Arr(i, j) ^ 2
        Next j
    Next i

    ArrPwr2 = Pwr2Arr

End Function

Task 1.2: TestArrPwr2



Code 2: TestP2R macro
Private Sub TestArrPwr2()
Dim Ans As Variant

    Ans = ArrPwr2(Range("Sheet1!B3:C5"))

Stop    ' Allow access to Locals Window
End Sub


Task 2: Power2



Code 3: Power2 macro
 '' ================================
'' Task 2
'' ================================

Public Sub Power2()
Dim inRng As Range, outRng As Range
Dim DataSq() As Double
Dim Prompt1 As String, Prompt2 As String, Title As String, Default As String
Dim CR As Range, CRr As Integer, CRc As Integer
Dim i As Integer, j As Integer
Dim WSF As WorksheetFunction

    Title = "xlf Square Converter [^2]"
    Prompt1 = "Select range to square - numbers only"
    Prompt2 = "Select range for output"

    Set CR = ActiveCell.CurrentRegion
    Set WSF = WorksheetFunction

    CRr = CR.Rows.Count
    CRc = CR.Columns.Count

    ' Process Header row and Data row(s)
        If WSF.IsText(CR(1, 1)) And WSF.IsNumber(CR(2, 1)) Then
            Set CR = CR.Offset(1, 0).Resize(CRr - 1, CRc)
        End If

        If WSF.Count(CR) = CR.Cells.Count And WSF.Count(CR) >= 1 Then
            Default = CR.Address
        End If

    ' Display InputBox method - 1
        On Error Resume Next
Box1:   Set inRng = Application.InputBox(Prompt:=Prompt1, Title:=Title, Default:=Default, Type:=8)
            If inRng Is Nothing Then Exit Sub
        On Error GoTo 0

    ' Calculate squared values
        DataSq = ArrPwr2(inRng) ' DataSq inherits the dimension of inRng

    ' Display InputBox method - 2
        On Error Resume Next
        Set outRng = Application.InputBox(Prompt:=Prompt2, Title:=Title, Type:=8)
            If outRng Is Nothing Then GoTo Box1
        On Error GoTo 0

    ' Write output to WS
            Set outRng = outRng.Resize(1, 1)
            For i = 1 To UBound(DataSq, 1)
                For j = 1 To UBound(DataSq, 2)
                    outRng(i, j).Value = DataSq(i, j)
                Next j
            Next i

End Sub