LookUp Value and Concatenate All Found Results

[shaft1]

Hi

I have a beginner with the VB codes ad macros but slowly getting my head around it and i am enjoying no matter how much i struggle with these.

i need to look up two columns (columns F & G) and find matching values in columns C and A respectively. And return multiple results (from column B) concatenated as shown in the attached spreadsheet.

I am most likely to have thousands of rows of these sort of data and have the need to automate as you can understand.

I have already included Rick Rothstein's LookUpConcat UDF along with the Macro as listed below in the attached spreadsheet...
(from
http://www.excelfox.com/forum/f22/lookup-value-and-concatenate-all-found-results-345/)

UDF + macro



Function LookUpConcat(ByVal SearchString As String, SearchRange As Range, ReturnRange As Range, _
Optional Delimiter As String = " ", Optional MatchWhole As Boolean = True, _
Optional UniqueOnly As Boolean = False, Optional MatchCase As Boolean = False)

Dim X As Long, CellVal As String, ReturnVal As String, Result As String

If (SearchRange.Rows.Count > 1 And SearchRange.Columns.Count > 1) Or _
(ReturnRange.Rows.Count > 1 And ReturnRange.Columns.Count > 1) Then
LookUpConcat = CVErr(xlErrRef)
Else
If Not MatchCase Then SearchString = UCase(SearchString)
For X = 1 To SearchRange.Count
If IsError(SearchRange(X)) Then GoTo Continue
If MatchCase Then
CellVal = SearchRange(X).Value
Else
CellVal = UCase(SearchRange(X).Value)
End If
ReturnVal = ReturnRange(X).Value
If MatchWhole And CellVal = SearchString Then
If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
Result = Result & Delimiter & ReturnVal
ElseIf Not MatchWhole And CellVal Like "*" & SearchString & "*" Then
If UniqueOnly And InStr(Result & Delimiter, Delimiter & ReturnVal & Delimiter) > 0 Then GoTo Continue
Result = Result & Delimiter & ReturnVal
End If
Continue:
Next

LookUpConcat = Mid(Result, Len(Delimiter) + 1)
End If
End Function


Sub LookUpAndConcatenate()
Dim Cell As Range, LastRow As Long, ResultRow As Long
Dim SearchRange As Range, ReturnRange As Range
Const SearchCol As String = "B"
Const ReturnCol As String = "C"
Const ResultCol As String = "N"
Const StartRow As Long = 3
LastRow = Cells(Rows.Count, SearchCol).End(xlUp).Row
Set SearchRange = Cells(StartRow, SearchCol).Resize(LastRow - StartRow + 1)
Set ReturnRange = Cells(StartRow, ReturnCol).Resize(LastRow - StartRow + 1)
For Each Cell In SearchRange
Cells(Cell.Row, ResultCol).Value = LookUpConcat(Cell.Value, SearchRange, ReturnRange)
Next
End Sub


HOWEVER the code will only look up one column at a time (and gives all the result) where as i need it to look say itemA with frequency 1 and give me the desired outcomes as A1,A2 from Column B etc.

Also the macro at the end that uses the UDF LookUpConcat gives an output in every cell, i.e. has repetition that i am trying to eliminate (see Column L for itemB).

Please advise what modification need to be done to the codes ?
thanks in advance,
Shaft.

ps. is it possible to generate 3 sheets automatically everytime the macro is run for corresponding frequency and these sheets to be customised formatted sheets. i.e. i will need to create a customised sheets for each of the frequency and the macro code will dump the results in the corresponding customised sheets?

[Admin]

Hi

Try this UDF


Option Explicit

Function CONCATEIFS(ByRef OutputRange As Range, ByVal Delim As String, _
ByRef InputRange1 As Range, ByRef Input1 As Variant, _
ByRef InputRange2 As Range, ByRef Input2 As Variant)

Dim OpR, IpR1, IpR2, Flg As Boolean, Temp
Dim i As Long, IP1 As String, IP2 As String

CONCATEIFS = CVErr(xlErrNA)
Flg = (OutputRange.Rows.Count = InputRange1.Rows.Count) * (OutputRange.Rows.Count = InputRange2.Rows.Count)
If Flg Then
If TypeOf Input1 Is Range Then
Input1 = StrConv(Input1.Value2, 1)
Else
Input1 = StrConv(Input1, 1)
End If
If TypeOf Input2 Is Range Then
Input2 = StrConv(Input2.Value2, 1)
Else
Input2 = StrConv(Input2, 1)
End If

OpR = OutputRange.Value2
IpR1 = InputRange1.Value2
IpR2 = InputRange2.Value2

For i = 1 To UBound(IpR1, 1)
IP1 = StrConv(IpR1(i, 1), 1)
IP2 = StrConv(IpR2(i, 1), 1)
If IP1 = Input1 Then
If IP2 = Input2 Then
Temp = Temp & Delim & OpR(i, 1)
End If
End If
Next
If Len(Temp) Then CONCATEIFS = Mid(Temp, Len(Delim) + 1)
End If

End Function

in H3

=CONCATEIFS($B$3:$B$34,",",$A$3:$A$34,G3,$C$3:$C$34,F3)

in I3

=CONCATEIFS($D$3:$D$34,"*",$A$3:$A$34,G3,$C$3:$C$34,F3)

[shaft1]

thanks heaps. it works like a charm.
just needed to remove the space in the H3 and I3 formula.

also i will have thousands of rows of data and having live formulas will just slow dow the excel.
is it possible to have a macro that will copy the data from columnH and I and paste into Column H and I respectively after performing the concat udf.
thanks.

[shaft1]

the udf works fine if all the raw data and the results are in the same sheet.
however it gives me blank if i use the formula to get the results in a different sheet.
i should have made this clear, my apologies.

in my final spreadsheet the two columns i am looking for "item" and "frequency" wont be adjacent to each other and nor will the raw data.
any way of achieving this.
I have attached the spreadsheet with formulas already and sheet 1 with results are showing blanks.
thanks in advance.

[shaft1]

if possible i would also like to insert the "[ ]" brackets only right after every result it finds.
e.g. A1 [ ],A2 [ ],B2 [ ]
1. keeping in mind i dont want the coma after the end value.
2. space between result and [ ] is ok. eg, A1 [ ]
3. no space required between "," and next value, eg ,B2 [ ]

please let me know,
thanks in advance,

[Admin]

Hi,

My UDF works fine. You can put a space in the delim parameter. Like ", "