CODEWITHSUNDEEP
excelvba
SoftTimur
SoftTimur

Reputation: 5490

Apply worksheet function ROW to the result of a VBA

enter image description here

I would like to define a function RangeDown in VBA. It finds a header in the second range argument, and returns the range under the header within the third range argument. Here is my current code:

Function RangeDown(header, range_header, range_data)
    i = 0
    row_header = 0
    col_header = 0
    For Each Cell In range_header
        If Cell.Value = header Then
            i = i + 1
            row_header = Cell.Row
            col_header = Cell.Column
        End If
    Next Cell
    If i = 0 Then
        RangeDown = "Cannot find the header"
    ElseIf i > 1 Then
        RangeDown = "Found more than one matching headers"
    Else
        lastRow = range_data.Row + range_data.Rows.Count - 1
        If row_header >= lastRow Then
            RangeDown = "No Range"
        Else
            Set r = Range(Cells(row_header + 1, col_header), Cells(lastRow, col_header))
            Set x = Application.Intersect(r, range_data)
            RangeDown = x
        End If
    End If
 
End Function

In general, the above code works. However, I just realized that we cannot apply the function ROW to the result of RangeDown, Formulas like =LET(x, RangeDown("header4",C5:H5,C3:H9), ROW(x)) return #VALUE!:

enter image description here

Does anyone know how to amend the VBA code such that we could apply ROW on the result?

Upvotes: 1

Views: 198

Answers (1)

Ike
Ike

Reputation: 13014

The UDFRangeDown has to return a range.

As @GSerg said, you have to use SET to return the range.

PLUS you have to amend your formula like this:

=LET(x,RangeDown("header 6", C5:H5,C3:H9),IFERROR(ROW(x),x))

In case RangeDown returns the error text, ROW will fail (IFERROR = true) and the result of x (= error message) will be returned.

Function RangeDown(header As String, _
                    range_header As Range, _
                    range_data As Range) As Variant
    i = 0
    row_header = 0
    col_header = 0
    For Each Cell In range_header
        If Cell.Value = header Then
            i = i + 1
            row_header = Cell.Row
            col_header = Cell.Column
        End If
    Next Cell
    If i = 0 Then
        RangeDown = "Cannot find the header"
    ElseIf i > 1 Then
        RangeDown = "Found more than one matching headers"
    Else
        lastRow = range_data.Row + range_data.Rows.Count - 1
        If row_header >= lastRow Then
            RangeDown = "No Range"
        Else
            Set r = Range(range_header.Worksheet.Cells(row_header + 1, col_header), range_header.Worksheet.Cells(lastRow, col_header))
            Set x = Application.Intersect(r, range_data)
            Set RangeDown = x
        End If
    End If
End Function

Upvotes: 1

Related Questions