Reputation: 479
New to VBA, trying to create a function that essentially searches a column for certain values. If it finds a hit then it returns a corresponding column, else returns a space. The way the worksheet is formatted, one cell can have multiple values (separated by ALT+ENTER, so each new value is on a separate line).
The code I used currently works but has an issue: Since I am using inStr the code is returning partial matches as well (which I do not want).
Example:
**Column to Search (one cell)**
ABC
AB
B
When I run the code to find AB, it will return hits for both AB and ABC since AB is part of it.
Ideal solution would be to first split the cells based on ALT+ENTER and loop through all values per cell and then return the desired value. But not how the syntax would look.
Current Code
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range)
Dim i As Long
Dim result As String
Dim mRange As Range
Dim mValue As String
For i = 1 To Search_in_col.Count
If InStr(1, Search_in_col.Cells(i, 1).Text, Search_string) <> 0 Then
If (Return_val_col.Cells(i, 1).MergeCells) Then
Set mRange = Return_val_col.Cells(i, 1).MergeArea
mValue = mRange.Cells(1).Value
result = result & mValue & ", "
Else
result = result & Return_val_col.Cells(i, 1).Value & ", "
End If
End If
Next
Example: Adding an example to better explain the situation
Upvotes: 1
Views: 1640
Reputation: 60174
You can use regular expressions which have a word boundary token. The following seems to reproduce what you show in your example:
Option Explicit
'Set reference to Microsoft VBScript Regular Expressions 5.5
Function col_return(lookFor As String, lookIn As Range) As String
Dim RE As RegExp
Dim C As Range
Dim S As String
Set RE = New RegExp
With RE
.Global = True
.IgnoreCase = True 'unless you want case sensitive searches
For Each C In lookIn
.Pattern = "\b(" & lookFor & ")\b"
If .Test(C.Text) = True Then
S = S & "," & C.Offset(0, -1)
End If
Next C
End With
col_return = Mid(S, 2)
End Function
I used early binding, which means you set a reference in VBA as noted in the comments.
You can use late-binding and avoid the reference. To do that you would change to the DIM and Set lines for RE to:
DIM RE as Object
Set RE = createobject("vbscript.regexp")
You can read about early vs late-binding by doing an internet search.
The formula I used and the layout is in the screenshot below:
Upvotes: 2
Reputation: 152450
you can split the string and loop that.
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String
If Search_in_col.Cells.Count <> Return_val_col.Cells.Count Then Exit Function
Dim sptStr() As String
sptStr = Split(Search_string, Chr(10))
Dim srchArr() As Variant
srchArr = Search_in_col.Value
Dim RetArr() As Variant
RetArr = Return_val_col.Value
Dim i As Long
For i = LBound(sptStr) To UBound(sptStr)
Dim j As Long
For j = LBound(srchArr, 1) To UBound(srchArr, 1)
If srchArr(j, 1) = sptStr(i) Then
newFunc = newFunc & RetArr(j, 1) & ", "
End If
Next j
Next i
newFunc = Left(newFunc, Len(newFunc) - 2)
End Function
EDIT:
As per the new information:
Function newFunc(Search_string As String, Search_in_col As Range, Return_val_col As Range) As String
Search_string = "|" & Search_string & "|"
Dim srchArr() As Variant
srchArr = Search_in_col.Value
Dim RetArr() As Variant
RetArr = Return_val_col.Value
Dim i As Long
For i = LBound(srchArr, 1) To UBound(srchArr, 1)
Dim T As String
T = "|" & Replace(srchArr(i, 1), Chr(10), "|") & "|"
If InStr(T, Search_string) > 0 Then
newFunc = newFunc & RetArr(i, 1) & ", "
End If
Next i
newFunc = Left(newFunc, Len(newFunc) - 2)
End Function
Upvotes: 4