Multiple instances of lookup diplayed in a single cell

[sgentile]

Have 20 categories numbered 1-20 in Column A; have risk factors identified against each 20 categories in Column B. There are 30 potential risk factors that could be assigned that are located in separate sheet, the factors run from -1 to -15 and 1 to 15. Not all will be used. Am trying to lookup all categories with the same risk factor and display the category numbers in single cell. For example in the risk category -1 cell I would like find and display all instances and display 5,14; for risk -2 cell only 1, risk cell -6 would have 13, 17 displayed, etc. These will populating a risk matrix with assigned risk factors that are already assigned. Any ideas, I am pulling my hair out. Thanks.<o></o>
<o></o>
Sample Final Display<o></o>

<o></o>	<o></o>	<o></o>	(RF -2) 1<o></o>	(RF -1) 5,14<o></o>
(RF-6) 9,17<o></o>	<o></o>	<o></o>	<o></o>	<o></o>
<o></o>	<o></o>	<o></o>	<o></o>	<o></o>

<TBODY>
</TBODY>

<o></o>
Categories Risk Factor <o></o>

1<o></o>​	-2<o></o>​	<o></o>​	<o></o>	<o></o>
2<o></o>​	-10<o></o>​	<o></o>​	<o></o>	<o></o>
3<o></o>​	-7<o></o>​	<o></o>​	<o></o>	<o></o>
4<o></o>​	3<o></o>​	<o></o>​	<o></o>	<o></o>
5<o></o>​	-1<o></o>​	<o></o>​	<o></o>	<o></o>
6<o></o>​	1<o></o>​	<o></o>​	<o></o>	<o></o>
7<o></o>​	6<o></o>​	<o></o>​	<o></o>	<o></o>
8<o></o>​	-4<o></o>​	<o></o>​	<o></o>	<o></o>
9<o></o>​	-6<o></o>​	<o></o>​	<o></o>	<o></o>
10<o></o>​	-3<o></o>​	<o></o>​	<o></o>	<o></o>
11<o></o>​	13<o></o>​	<o></o>​	<o></o>	<o></o>
12<o></o>​	-8<o></o>​	<o></o>​	<o></o>	<o></o>
13<o></o>​	-6<o></o>​	<o></o>​	<o></o>	<o></o>
14<o></o>​	-1<o></o>​	<o></o>​	<o></o>	<o></o>
15<o></o>​	-9<o></o>​	<o></o>​	<o></o>	<o></o>
16<o></o>​	-8<o></o>​	<o></o>	<o></o>	<o></o>
17<o></o>​	-6<o></o>​	<o></o>​	<o></o>	<o></o>
18<o></o>​	-15<o></o>​	<o></o>​	<o></o>	<o></o>
19<o></o>​	-5<o></o>​	<o></o>​	<o></o>	<o></o>
20<o></o>​	-13<o></o>​	<o></o>​	<o></o>	<o></o>
<o></o>​	<o></o>​	<o></o>​	<o></o>	<o></o>

<TBODY>
</TBODY>

 

[ZVI]

...

[FONT=Courier New][COLOR=darkblue]Function[/COLOR] AConcat(a [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], [COLOR=darkblue]Optional[/COLOR] Sep [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR] = "") [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String
[/COLOR][COLOR=green]   ' Harlan Grove, Mar 2002[/COLOR]
   ' ...
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Function[/COLOR]
[/FONT]

Then, assuming that A2:B21 contains the data, D2 contains -1, D3 contains -2, and D4 contains -6, enter the following formula in E2, confirm with CONTROL+SHIFT+ENTER, and copy down:

=SUBSTITUTE(AConcat(IF($B$2:$B$21=D2,","&$A$2:$A$21,"")),",","",1)

Hi Domenic,

Really nice combination of VBA and formula, thanks for sharing it!

Never saw earlier the AConcat UDF of Harlan Grove.
Let me comment some of its features.

1. For-Each-Next loops rows and columns differently for Range (rows are first) and Array (columns are first). It affects the order of concatenated items if there is more than one column in the referenced range.
2. For Each y In a.Cells is relatively slow because of interaction between VBA and Excel objects. For Each y In a.Cells.Value will improve speed because actually a.Cells.Value creates runtime variable which is referenced to runtime array of values. BTW, in this case the order of concatenations will be the same as for array (columns are first).
3. Concatenation AConcat & a & Sep is the slowest part in the code. The more items have to be concatenated in one string, the more slowly a code. For regret, spending time is not linear equation vs the length of result and vs items count.

Taking all of these into account, here is in hundred(s) times faster alternative:

' ZVI:2012-06-26 http://www.mrexcel.com/forum/showthread.php?t=642828
Function AConcat1(X, Optional Sep As String, Optional SkipEmpty As Boolean) As String
  Dim a, b(), v
  Dim i As Long, j As Long
  ' Copy Range/Array/Others to a variable
  a = X
  ' Concatenate
  If IsArray(a) Then
    ' Calculate items count in any-D array a()
    On Error Resume Next
    While Err.Number = 0
      i = i + 1
      j = j + UBound(a, i) - LBound(a, i) + 1
    Wend
    Err.Clear
    ' Prepare 1D output array b()
    ReDim b(1 To j)
    ' Copy items from a() to b()
    i = 0
    For Each v In a
      If SkipEmpty Then
        If Len(v) Then
          i = i + 1
          b(i) = v
        End If
      Else
        i = i + 1
        b(i) = v
      End If
    Next
    ' Cut the ending residual (not used) items of b()
    If i < j Then ReDim Preserve b(1 To i)
    ' Concatenate items of b() by very fast function Join
    AConcat1 = Join(b, Sep)
  Else
    ' Return string value of a-variable
    AConcat1 = a
  End If
End Function

It supports one more optional argument SkipEmpty.
If SkipEmpty = TRUE (or =1, actually not the zero) then empty items will not be returned in the result.

Therefore the formula of post #2: =SUBSTITUTE(AConcat(IF($B$2:$B$21=D2,","&$A$2:$A$21,"")),",","",1)
can be simplified by: =AConcat1(IF($B$2:$B$21=D2,$A$2:$A$21,""),",",1)

AConcat1 also supports arrays of any dimensions with any bounds, not sure if it's useful at all, may be only for the seldom VBA cases.

Below is the time test code to compare versions.
On my PC at testing conditions the updated version was in 500 times faster than the original one.

Sub TimeTest()
 
  Const RS& = 10000         ' Rows count (1D) in testing array
  Const CS& = 2             ' Columns count (2D) in testing array
  Const Txt$ = "Some text"  ' Add text here to see time vs length
 
  Dim a(), r As Long, c As Long, t1 As Single, t2 As Single
 
  'Prepare array a() with testing strings
  ReDim a(1 To RS, 1 To CS)
  For r = 1 To RS
    For c = 1 To CS
      a(r, c) = "Row #" & r & " Col #" & c & " " & Txt
    Next
  Next
 
  ' Speed test for AConcat()
  t1 = Timer
  AConcat a, ","
  t1 = Timer - t1
  Debug.Print "AConcat, t1 = " & Round(t1, 3)
 
  ' Speed test for AConcat1()
  t2 = Timer
  AConcat1 a, ","
  t2 = Timer - t2
  Debug.Print "AConcat1, t2 = " & Round(t2, 3)
  Debug.Print "Ratio = t1/t2 = " & Round(t1 / t2)
 
End Sub

Just for fun

Regards
Vlad

 

[ZVI]

Range (rows are first) and Array (columns are first)

More correctly: Range (cells/items in rows are first) and Array (cells/items in columns are first),
where for array the rows are actually items of the 1st dimension, columns are items of the 2nd dimension.

 

[Domenic]

Hi Vladimir,

Thanks for taking the time to comment on the solution. I`ll have to have a look at it in detail as soon as I get a chance.

Cheers!

 

[Domenic]

ZVI,

Very nice! Your solution is indeed more efficient and faster. And, the order of concatenation is always the same. Very clever! That's great! One minor correction, though. I think in order to calculate the items count correctly, we will need to replace...

While Err.Number = 0  i = i + 1
  j = j + UBound(a, i) - LBound(a, i) + 1
Wend

with

j = 1
While Err.Number = 0
  i = i + 1
  j = j * (UBound(a, i) - LBound(a, i) + 1)
Wend

For-Each-Next loops rows and columns differently for Range (rows are first) and Array (columns are first). It affects the order of concatenated items if there is more than one column in the referenced range.

Very true. In this case, though, I think that because the custom function was designed primarily to be used as a worksheet formula, and that concatenation usually involves a single column or row, it wasn't a real concern.

For Each y In a.Cells is relatively slow because of interaction between VBA and Excel objects. For Each y In a.Cells.Value will improve speed because actually a.Cells.Value creates runtime variable which is referenced to runtime array of values. BTW, in this case the order of concatenations will be the same as for array (columns are first).

Good point...

Concatenation AConcat & a & Sep is the slowest part in the code. The more items have to be concatenated in one string, the more slowly a code. For regret, spending time is not linear equation vs the length of result and vs items count.

Concatenation may have been used for compatibility reasons. Join is not supported in the Mac version of Excel. Although, it might be supported now with the latest 2011 version.

Thanks ZVI! I really appreciate your comments and solution!

Cheers!

 

[ZVI]

Domenic, thank you very much for detailed comments, as well as for the testing code and fixing the items count part!

Concatenation may have been used for compatibility reasons. Join is not supported in the Mac version of Excel.

Good point! For this case the fast VBA alternative can be used instead of Join as follows:

' ZVI:2012-06-29 http://www.mrexcel.com/forum/showthread.php?t=642828
Function AConcat2(X, Optional Sep As String, Optional SkipEmpty As Boolean) As String
  Dim a, b(), v
  Dim i As Long, j As Long, k As Long
  Dim buf As String, s As String, Ok As Boolean
  ' Length of separator
  k = Len(Sep)
  ' Copy Range/Array/Others to variable
  a = X
  ' Concatenate
  If IsArray(a) Then
    ' Calculate items count in any-D array a()
    On Error Resume Next
    j = UBound(a) - LBound(a) + 1
    i = 1
    While Err.Number = 0
      i = i + 1
      j = j * (UBound(a, i) - LBound(a, i) + 1) ' Thanks Domenic for this fixing!
    Wend
    Err.Clear
    ' Prepare output buffer. Init size 32768 is not critical, it can be even = 1
    buf = String(32768, Sep)
    i = 0: j = 0
    For Each v In a
      If SkipEmpty Then Ok = Len(v) > 0 Else Ok = True
      If Ok Then
        s = v
        j = i + Len(s)
        ' Increase the size of buffer if required
        While j + k > Len(buf)
          buf = buf & String(Len(buf), Sep)
        Wend
        ' Fast copy item to the string buffer without slow memory allocation
        Mid$(buf, i + 1) = s
        ' If length of Sep is more than 1 char (1 char Sep is already filled in the buf) then copy it too
        If k > 1 Then Mid$(buf, j + 1) = Sep
        i = j + k
      End If
    Next
    ' Return the actual characters of buffer without last Sep string
    AConcat2 = Left$(buf, i - k)
  Else
    ' Just return the string conversion of input value
    AConcat2 = a
  End If
End Function

Cheers!
Vlad

 

[ZVI]

Actually, the part of code for calculating items count in any-D array a() is not required for AConcat2
Therefore the code can be simplified:

' ZVI:2012-06-29 http://www.mrexcel.com/forum/showthread.php?t=642828
Function AConcat2(X, Optional Sep As String, Optional SkipEmpty As Boolean) As String
  Dim a, b(), v
  Dim i As Long, j As Long, k As Long
  Dim buf As String, s As String, Ok As Boolean
  ' Length of separator
  k = Len(Sep)
  ' Copy Range/Array/Others to a variable
  a = X
  ' Concatenate
  If IsArray(a) Then
    ' Prepare output buffer. Initial size 32768 is not critical, it can be even = 1
    buf = String(32768, Sep)
    i = 0: j = 0
    For Each v In a
      If SkipEmpty Then Ok = Len(v) > 0 Else Ok = True
      If Ok Then
        s = v
        j = i + Len(s)
        ' Increase the size of buffer if required
        While j + k > Len(buf)
          buf = buf & String(Len(buf), Sep)
        Wend
        ' Fast copy of the item to the string buffer without slow memory reallocation
        Mid$(buf, i + 1) = s
        ' If length of Sep is more than 1 char (already filled in buf) then copy it too
        If k > 1 Then Mid$(buf, j + 1) = Sep
        i = j + k
      End If
    Next
    ' Return the actual characters stored in buffer without last Sep string
    AConcat2 = Left$(buf, i - k)
  Else
    ' Just return the string conversion of input value
    AConcat2 = a
  End If
End Function

Best Regards,
Vlad