How to create a function that returns an range-CodePudding

I am looking to create a function that will take 2 ranges (of the same dimensions), and take the difference between the cell from one range and the corresponding cell in the other range, and then create a new range with all of the differences. Are there any obvious problems? If i select and crtl sht enter, the range fills with "#Value!"

This is what i have so far (assuming the ranges are 4 by 4s):

Function Compare_Ranges(range_1 As Range, range_2 As Range) As Range

    Dim output_data As Range
    Dim i As Integer
    Dim j As Integer
    Dim col As String
    
              
    For i = 1 To 4 'looping through the columns
        col = Col_Letter(i)
        For j = 1 To 4  'looping through the rows
            Set output_data(Col_Letter(i) & j) = range_1(Col_Letter(i) & j).Value - range_2(Col_Letter(i) & j).Value
        Next j
    Next i
    
    Compare_Ranges = output_data

End Function

Where the function Col_Letter returns the correponding letter of the alphabet:

Function Col_Letter(lngCol As Integer) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Col_Letter = vArr(0)
End Function

CodePudding user response：

Here is a version of your function that takes two ranges of the same size and returns an array with the same dimensions that holds the difference between each corresponding cell in the input ranges.

Function Compare_Ranges(range_1 As Range, range_2 As Range) As Variant

    Dim output_data() As Variant
    Dim c As Integer
    Dim r As Integer
    
    ReDim output_data(1 To range_1.Rows.Count, 1 To range_1.Columns.Count)
              
    For c = 1 To UBound(output_data, 2) 'looping through the  columns
        For r = 1 To UBound(output_data, 1) 'looping through the rows
             output_data(r, c) = range_1.Cells(r, c).Value - range_2.Cells(r, c).Value
        Next
    Next
    
     Compare_Ranges = output_data

End Function

If you want to put this in a cell, you will need to press CTRL ENTER after entiering the following in a cell:

=Compare_Ranges(A1:A7,B1:B7)

The function returns an array, so if you want to catch it's results by calling it in another sub procedure, you need the following"

Dim data as variant
data = Compare_Ranges(range("a1:a7"),range("b1:b7"))

CodePudding user response：

I am not sure if I got this right but I hope at least will help you to get there. The function takes any two ranges and calculate the difference between them and store the result into an array.

Function Compare_Ranges(range_1 As Range, range_2 As Range, ByVal y As Long) As Variant
Dim j As Long
Dim col As String
Dim one As Object, two As Object, three As Variant

Set one = CreateObject("Scripting.Dictionary")
Set two = CreateObject("Scripting.Dictionary")

j = 0
For Each cell In range_1
    one.Add Key:=j, Item:=cell.Value
    j = j   1
Next

j = 0
For Each cell In range_2
    two.Add j, cell.Value
    j = j   1
Next

ReDim three(0 To j) As Variant
For i = 0 To j
    three(i) = one(i) - two(i)
Next
Compare_Ranges = three(y)
End Function

Then you can use the code in the sub to populate them in any range you like.

Sub result()
Dim one As Range, two As Range, three As Range
Dim j As Long


Set one = Worksheets("Sheet1").Range("A1:A4")
Set two = Worksheets("Sheet1").Range("B1:B4")
Set result = Worksheets("Sheet1").Range("D8:D11")

j = 0

For i = three.Row To ((result.Row   result.Rows.Count) - 1)
    Worksheets("Sheet1").Cells(i, result.Column) = Compare_Ranges(one, two, j)
    j = j   1
Next

End Sub