JB0x2D1
JB0x2D1

Reputation: 930

Get value from one-row range at specified column

I'm trying to define an Excel function in VBA where I can specify Apple or Orange as in =MyFunc("Apple") and get returned "Tom" or "Dick, Harry". I'm able to figure out which Row the search query is on using Find but I can't figure out how to scan part of that Row for "X" (or not empty) and return the value(s) from the top Row corresponding to the "X".

  ...  B  ...  M        N  ...   CR
  ___________________________________
3 |        |  Tom  |  Dick  |  Harry
  +--------+-------+--------+--------
4 | Apple  |   X   |        |
  +--------+-------+--------+--------
5 | Orange |       |    X   |    X

What I've got so far:

Function MyFunc(what As String, Optional sep As String = ", ") As String
Dim rngSearch As Range, rngFound As Range
Dim strResult As String, allNames As Range
Set rngSearch = Worksheets("Sheet1").Range("B:B")
Set allNames = Worksheets("Sheet1").Range("M3:CR3")
Set rngFound = rngSearch.Find(what, LookIn:=xlValues, LookAt:=xlPart)
If rngFound Is Nothing Then
    MsgBox "Not found"
Else
    MsgBox rngFound.Row
    'search that row from Col M to Col CR for "X", add value in Row 3 to strResult if X is found
End If
MyFunc = strResult
End Function

Upvotes: 0

Views: 159

Answers (1)

Scott Craner
Scott Craner

Reputation: 152660

This will do what you want.

I used arrays to speed up the process.

Function MyFunc(what As String, Optional sep As String = ", ") As String
Dim nmerng() As Variant
Dim xrng() As Variant
Dim rw As Variant
Dim ws As Worksheet
Dim i&

Set ws = ActiveSheet
With ws
    'load the names in an array
    nmerng = .Range("M3:CR3").Value
    'find correct row to check
    rw = Application.Match(what, .Range("B:B"), 0)
    'If value is not found then rw will be an error
    If IsError(rw) Then
        MyFunc = "Not Found"
        Exit Function
    End If
    'load row to check in array
    xrng = .Range("M" & rw & ":CR" & rw).Value
    'cycle through array finding all the "X"
    For i = LBound(xrng, 2) To UBound(xrng, 2)
        If xrng(1, i) = "X" Then
            'Concatenate the names where there is an "X"
            MyFunc = MyFunc & nmerng(1, i) & sep
        End If
    Next i
    'Remove the last two characters of extra sep
    MyFunc = Left(MyFunc, Len(MyFunc) - Len(sep))
End With

End Function

enter image description here

Upvotes: 2

Related Questions