Search for partial string using vba

[jb]

Hello helpers,
I have following code to concatenate multiple cells based on condition.
I have range of cells from b17 to p17 having some text. I have a word in A26. I am searching A26 in b17 to p17 and if match is found then corresponding cells from b16 to p16 will be concatenated with : as separator. This formula works fine if content of a26 is available in b17 to p17 with exact match. But my problem is the word in a26 may be available in b17 to p17 as partial string. I an unable to modify below code to match a26 partially in b17 to p17. please help.

=ConcatenateIf($B$17:$P$17, A26, $B$16:$P$16, " : ")

for e.g a26 has word PP and some cells between b17 to p17 may contain word PP or PP / RT or YP / PP / RT.

>>> use code - tags <<<

Function ConcatenateIf(CriteriaRange As Range, Condition As Variant, ConcatenateRange As Range, Optional Separator As String = " : ") As Variant
'Updateby Extendoffice
Dim xResult As String
On Error Resume Next
If CriteriaRange.Count <> ConcatenateRange.Count Then
    ConcatenateIf = CVErr(xlErrRef)
    Exit Function
End If
For i = 1 To CriteriaRange.Count
    If CriteriaRange.Cells(i).Value = Condition Then
        xResult = xResult & Separator & ConcatenateRange.Cells(i).Value
    End If
Next i
If xResult <> "" Then
    xResult = VBA.Mid(xResult, VBA.Len(Separator) + 1)
End If
ConcatenateIf = xResult
Exit Function
End Function

 

[KidneyStone]

Hello jb,

You can try this approach:

Option Explicit
Option Compare Text


Function ConcatenateIf(CriteriaRange As Range, Condition As Variant, ConcatenateRange As Range, Optional Separator As String = " : ") As Variant
'Updateby Extendoffice
Dim xResult As String, i As Long
On Error Resume Next
If CriteriaRange.Count <> ConcatenateRange.Count Then
    ConcatenateIf = CVErr(xlErrRef)
    GoTo ExitFn
End If
For i = 1 To CriteriaRange.Count
    If CriteriaRange.Cells(i).Value = Condition Then
        xResult = xResult & Separator & ConcatenateRange.Cells(i).Value
        GoTo MyNxti
    End If
    If InStr(CriteriaRange.Cells(i).Value, Condition) Then
        xResult = xResult & Separator & ConcatenateRange.Cells(i).Value
    End If
MyNxti:
Next i
If xResult <> "" Then
   xResult = VBA.Mid(xResult, VBA.Len(Separator) + 1)
End If
ConcatenateIf = xResult
ExitFn:
End Function

You could also then get away without including the original if function.

 

[Marc L]

Hello,​

​

should be simplified just removing the useless :​

Function HConcatenateIf$(RCrit As Range, VCOND, RConc As Range, Optional SEP$ = " : ")
    Dim V, C%
        If RCrit.Count <> RConc.Count Or RCrit.Rows.Count > 1 Or RConc.Rows.Count > 1 Then Exit Function
        V = Application.Index(RConc.Value2, 1, 0)
    For C = 1 To UBound(V)
        If InStr(RCrit(1, C), VCOND) = 0 Then V(C) = False
    Next
         HConcatenateIf = Join$(Filter(V, False, False), SEP)
End Function

Do you like it ? So thanks to click on bottom right Like !​

​

 

[Marc L]

Should be more simple if it is always two consecutive rows, the first to concatenate and the second as criteria​

like =RowConcatIf(B16:P17,A26) [no matters if only the first row is defined like =RowConcatIf(B16:P16,A26)] :​

Function RowConcatIf$(Rg As Range, VCOND, Optional SEP$ = " : ")
    Dim V, C%
        V = Application.Index(Rg.Value2, 1, 0)
    For C = 1 To UBound(V)
        If InStr(Rg(2, C), VCOND) = 0 Then V(C) = False
    Next
         RowConcatIf = Join$(Filter(V, False, False), SEP)
End Function

You may Like it !​

 

[shrivallabha]

If you have Office 365 then you can do this without VBA as well. Following formula will produce the same result.
=TEXTJOIN(" : ",TRUE,IF(ISNUMBER(SEARCH(A26,B17: P17,1)),B16: P16,""))

See attached Excel file.
Note: I had to insert a space as the forum software changes cell address into smileys. i.e. : P17 becomes .

 

[Marc L]

as the forum software changes cell address into smileys

Hi ! I had the same issue in my previous post, the reason why I used in the Insert menu (3 dots icon) the 'Inline code' feature …​

​

 

[Marc L]

According to post #4 UDF and post #5 formula the ultimate UDF whatever the Excel version :​

Function HConcatIf$(Rg As Range, VCOND, Optional SEP$ = " : ")
         HConcatIf = Join$(Filter(Evaluate("IF(ISNUMBER(SEARCH(""" & VCOND & """," & Rg.Rows(2).Address & _
                                           ",1))," & Rg.Rows(1).Address & ")"), False, False), SEP)
End Function

You should Like it !​

​