Reputation: 930
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
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
Upvotes: 2