• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Search for partial string using vba

jb

Member
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 <<<
Code:
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
 
Last edited by a moderator:

KidneyStone

New Member
Hello jb,

You can try this approach:

Code:
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

Excel Ninja
Hello,​
should be simplified just removing the useless :​
Code:
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

Excel Ninja
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)] :​
Code:
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

Excel Ninja
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 :p .
 

Attachments

Marc L

Excel Ninja
According to post #4 UDF and post #5 formula the ultimate UDF whatever the Excel version :​
Code:
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 !​
 
Top