Concatenate IF

[WillRust]

Hi,

I have two columns showing the link between a downstream station and an upstream station along a sewer.</SPAN>
So my columns consist of A (downstream station) and B (1^st</SPAN> Tier upstream station);</SPAN>

For example...</SPAN>
A ----B</SPAN>
X ----Y</SPAN>
Y ----Z</SPAN>
Y ----W</SPAN>
W ----V</SPAN>
W ----Q</SPAN>
Q ----K</SPAN>

(don't know how to make it look like columns, sorry, had to use "-----" to mean space between columns)

So, Y flows into X. Both Z and W flow into Y. Both V and Q flow into W and K flows into Q. So essentially we have a branch system of stations, but here they are represented as links between upstream and downstream.</SPAN>

Now, if there is only ONE station upstream, I can easily list that in the next column by =VLOOKUP(B2,$A$2:$B$2189,2,FALSE). However this fails if there are more than two stations flowing into the downstream station (for instance above where we have Z and W both flowing into Y) – since the Vlookup only displays the first instance it comes across. </SPAN>

The end result I am after, is a mechanism to show each tier of upstream stations in a next column, but where there are two stations going into one, at a single tier, for them to be listed as Concatenate. A sort of Concatinate A:A if B1 = B:B? For each column.</SPAN>

So the end result would be...</SPAN>

A---- B ----Tier2 ----Tier 3 ----etc... (for about 10 Tiers) </SPAN>
X ----Y ----Z,W -----V </SPAN>
Y ----Z </SPAN>
Y ----W ----V,Q -----K</SPAN>
W----V </SPAN>
W ---Q -----K</SPAN>
Q ----K</SPAN>

So, in the first tier upstream if Y is station Z and W, and in the next tier is station V...</SPAN>
Note: there will never be multiple DOWNSTREAM stations to ONE UPSTREAM station</SPAN>

Any help would be much appreciated – I am assuming this has to be a visual basic job.</SPAN>

 

[mikerickson]

Since W >> V,Q should the result from that data be

A B tier2 tier3 tier4
X Y -Z,W -V,Q -K
Y Z
Y W -V,Q -K
W V
W Q -K
Q K

You can use these UDF's and put
=ConcatDelimitedCriteria($A:$A, B2, $B:$B, ",", "," )
in C2 and drag right and down

Function ConcatDelimitedCriteria(ByVal compareRange As Range, _
                    ByVal delimitedCriteria As String, ByVal stringsRange As Range, _
                    Optional outputDelimiter As String = " ", Optional criteriaDelimiter As String = " ") As String
    Dim oneCriteria As Variant
    
    For Each oneCriteria In Split(delimitedCriteria, criteriaDelimiter)
    
        ConcatDelimitedCriteria = ConcatDelimitedCriteria & outputDelimiter _
                & ConcatIf(compareRange, oneCriteria, stringsRange, outputDelimiter)
        
        ConcatDelimitedCriteria = Replace(ConcatDelimitedCriteria, outputDelimiter & outputDelimiter, outputDelimiter)
    
    Next oneCriteria
    
    ConcatDelimitedCriteria = Mid(ConcatDelimitedCriteria, Len(outputDelimiter) + 1)
End Function

Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
                    Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
                    
    Rem the first three argumens of ConcatIf mirror those of SUMIF
    Rem the Delimiter and NoDuplicates arguments are optional (default "" and False)
    Dim i As Long, j As Long
    
    With compareRange.Parent
        Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
    End With
    
    If compareRange Is Nothing Then Exit Function
    If stringsRange Is Nothing Then Set stringsRange = compareRange
    Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
                                            stringsRange.Column - compareRange.Column)
    
    For i = 1 To compareRange.Rows.Count
        For j = 1 To compareRange.Columns.Count
            If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
                If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                    ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
                End If
            End If
        Next j
    Next i
    ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
End Function

 

[WillRust]

Since W >> V,Q should the result from that data be

A B tier2 tier3 tier4
X Y -Z,W -V,Q -K
Y Z
Y W -V,Q -K
W V
W Q -K
Q K

You can use these UDF's and put
=ConcatDelimitedCriteria($A:$A, B2, $B:$B, ",", "," )
in C2 and drag right and down

Function ConcatDelimitedCriteria(ByVal compareRange As Range, _
                    ByVal delimitedCriteria As String, ByVal stringsRange As Range, _
                    Optional outputDelimiter As String = " ", Optional criteriaDelimiter As String = " ") As String
    Dim oneCriteria As Variant
    
    For Each oneCriteria In Split(delimitedCriteria, criteriaDelimiter)
    
        ConcatDelimitedCriteria = ConcatDelimitedCriteria & outputDelimiter _
                & ConcatIf(compareRange, oneCriteria, stringsRange, outputDelimiter)
        
        ConcatDelimitedCriteria = Replace(ConcatDelimitedCriteria, outputDelimiter & outputDelimiter, outputDelimiter)
    
    Next oneCriteria
    
    ConcatDelimitedCriteria = Mid(ConcatDelimitedCriteria, Len(outputDelimiter) + 1)
End Function

Function ConcatIf(ByVal compareRange As Range, ByVal xCriteria As Variant, Optional ByVal stringsRange As Range, _
                    Optional Delimiter As String, Optional NoDuplicates As Boolean) As String
                    
    Rem the first three argumens of ConcatIf mirror those of SUMIF
    Rem the Delimiter and NoDuplicates arguments are optional (default "" and False)
    Dim i As Long, j As Long
    
    With compareRange.Parent
        Set compareRange = Application.Intersect(compareRange, Range(.UsedRange, .Range("a1")))
    End With
    
    If compareRange Is Nothing Then Exit Function
    If stringsRange Is Nothing Then Set stringsRange = compareRange
    Set stringsRange = compareRange.Offset(stringsRange.Row - compareRange.Row, _
                                            stringsRange.Column - compareRange.Column)
    
    For i = 1 To compareRange.Rows.Count
        For j = 1 To compareRange.Columns.Count
            If (Application.CountIf(compareRange.Cells(i, j), xCriteria) = 1) Then
                If InStr(ConcatIf, Delimiter & CStr(stringsRange.Cells(i, j))) <> 0 Imp Not (NoDuplicates) Then
                    ConcatIf = ConcatIf & Delimiter & CStr(stringsRange.Cells(i, j))
                End If
            End If
        Next j
    Next i
    ConcatIf = Mid(ConcatIf, Len(Delimiter) + 1)
End Function

That works perfectly, thanks very much!

 

[WillRust]

That works perfectly, thanks very much!

Out of curiosity (and my lack of skill), what alterations would i need to make in order to get a comma after the last entry on the concantenated text? i.e. x,y,z, instead of x,y,z

cheers

 

[mikerickson]

=ConcatDelimitedCriteria($A:$A, B2, $B:$B, ",", "," ) & ","