Thursday, December 15, 2011

Gotcha of the Day: Combine rows into a single cell in Excel

Last night, Shira posed me a spreadsheet quandary: how do you take a series of rows and combine them together into a single cell (say, comma separated)? After looking around, I realized that there wasn't a built in function that would do this. transpose will turn rows in columns, but it doesn't join items up in a single cell. To get this job done, I was going to have to turn to VB. Gulp.

I knew how I wanted the function work, it should behave like countif. That is, I didn't want it to combine every cell in a range, only those that matched some criteria.

Why Excel offers countif and sumif but doesn't offer concatenateif is beyond me. But, luckily it wasn't beyond MikeRickson over at He and a couple other folks provided me with a bunch of wonderful useful bits of knowledge:

1. An implementation of >concatenateif(...):

Function concatenateIf(ByVal compareRange As Range, _ 
    ByVal criteriaEQ As Variant, _ 
    ByVal stringsRange As Range, _ 
    Optional Delimiter As String, _ 
    Optional Unique As Boolean) As String 
    Dim stringsRRay As Variant 
    Dim compRRay As Variant 
    Dim i As Long, j As Long 
    Set compareRange = Application.Intersect(compareRange, _ 
    compRRay = compareRange.Value 
    stringsRRay = compareRange.Offset(stringsRange.Row - compareRange.Row, _ 
    stringsRange.Column - compareRange.Column).Value 
    Select Case TypeName(compRRay) 
    Case "Variant()" 
        concatenateIf = Delimiter 
        For i = 1 To UBound(compRRay, 1) 
            For j = 1 To UBound(compRRay, 2) 
                If compRRay(i, j) = criteriaEQ Then 
                    If Unique Imp (InStr(concatenateIf, Delimiter & CStr(stringsRRay(i, j)) & Delimiter) = 0) Then 
                        concatenateIf = concatenateIf & CStr(stringsRRay(i, j)) & Delimiter 
                    End If 
                End If 
            Next j 
        Next i 
        concatenateIf = Left(concatenateIf, Len(concatenateIf) - Len(Delimiter)) 
        concatenateIf = Mid(concatenateIf, Len(Delimiter) + 1) 
    Case "Double", "String", "Boolean": Rem cell.count = 1 
        If compRRay = criteriaEQ Then concatenateIf = CStr(stringsRRay) 
    Case Else 
        concatenateIf = TypeName(compRRay) 
    End Select 
End Function 

2. A simpler concat function which dispenses with the criteria concept:

Function Concat(r As Range) As String 
    Dim av  As Variant 
    Dim v   As Variant 
    av = Intersect(r, ActiveSheet.UsedRange) 
    For Each v In av 
        If Not IsEmpty(v) Then 
            Concat = Concat & v & "," 
        End If 
    Concat = Left(Concat, Len(Concat) - 1) 
End Function

3. Instructions on how to set these functions up.

[The code] needs to be posted in a code module. Open the VBE (Alt+F11), and from that menu bar, do Insert > Module, and paste the code into the window that opens.

Besides providing some useful code, this forum post showed me just how easy it is to add new functions to Excel. I've written VB code before, but it's usually as a stand alone app, and not something that truly leverages the existing Excel model.

I can't remember the last time such a brief forum post was so enlightening.

With the above code in place I was able to say:

 =concatenateif(A:A, "=100", C:C, ", ")

(Where column A (A:A) contained a bunch of numbers, and column C contained the text I wanted to join up with ", ".)

No comments:

Post a Comment


Related Posts with Thumbnails