Function to display column header text

[john316swan]

I have a pivot table with data:

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Doc 1[/TD]
[TD]doc 2[/TD]
[TD]doc 3[/TD]
[TD]doc 4[/TD]
[TD]combine docs[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD][/TD]
[TD]1[/TD]
[TD][/TD]
[TD]Doc 1,Doc 3 (=combineDocs(A2:A4))[/TD]
[/TR]
[TR]
[TD][/TD]
[TD]1[/TD]
[TD]1[/TD]
[TD][/TD]
[TD]Doc 2,Doc 3 (=combineDocs(B2:B4))[/TD]
[/TR]
</tbody>[/TABLE]

I am trying to write a function (combine docs) that combines all documents in 1 string

I found this code online that I modified but I can't figure out how to have the column header value displayed:

Function combineDocs(workRng As Range, Optional Sign As String = ",") As String
Dim r As Range
Dim OutStr As String


For Each r In workRng
    If r.Text <> "" Then
        OutStr = OutStr & Cells(2, Left(r, 1)).Text & Sign 'note my column header is on row 2
    End If
Next
combineDocs = Left(OutStr, Len(OutStr) - 1)
End Function

Thanks for your help!

 

[Rick Rothstein]

Give this function a try...

[table="width: 500"]
[tr]
	[td]Function CombineDocs(Rng As Range, Optional Delimiter As String = ",") As String
  CombineDocs = Replace(Replace(Application.Trim(Join(Evaluate("IF(" & Rng.Address & "="""","""",SUBSTITUTE(A1:D1,"" "",CHAR(1)))"), " ")), " ", Delimiter), Chr(1), " ")
End Function[/td]
[/tr]
[/table]

 

[Rick Rothstein]

Give this function a try...

[table="width: 500"]
[tr]
	[td]Function CombineDocs(Rng As Range, Optional Delimiter As String = ",") As String
  CombineDocs = Replace(Replace(Application.Trim(Join(Evaluate("IF(" & Rng.Address & "="""","""",SUBSTITUTE(A1:D1,"" "",CHAR(1)))"), " ")), " ", Delimiter), Chr(1), " ")
End Function[/td]
[/tr]
[/table]

I haven't tested it speedwise, but the following code should be more efficient (hence, ever so slightly quicker) than the function above (probably more understandable too)...

[table="width: 500"]
[tr]
	[td]Function CombineDocs(Rng As Range, Optional Delimiter As String = ",") As String
  Dim C As Long, Data As Variant, Header As Variant
  Data = Rng.Value
  Header = Intersect(Rng.EntireColumn, Rows(1)).Value
  For C = 1 To UBound(Data, 2)
    If Len(Data(1, C)) Then CombineDocs = CombineDocs & Delimiter & Header(1, C)
  Next
  CombineDocs = Mid(CombineDocs, Len(Delimiter) + 1)
End Function[/td]
[/tr]
[/table]

 

[john316swan]

Thanks Rick, I was just responding & I see you posted another code The first version worked but it was bound to columns A:D (outlined in my sample table) but the data table I am using is a pivot table that can grow & shrink column width so the 2nd code you gave gives more flexibility. I really appreciate your help & hope to one day be able to contribute as much as you have. Take care!

 

[Rick Rothstein]

The first version worked but it was bound to columns A:D (outlined in my sample table)

That is because I forgot to generalize the A1:D1 range. You should still use the second code I posted because, as I said, it should be a tad more efficient, but just to show you, my first code could be (was supposed to have been) general enough to handle a varying input range, here is the code the way I should have posted it...

[table="width: 500"]
[tr]
	[td]Function CombineDocs(Rng As Range, Optional Delimiter As String = ",") As String
  CombineDocs = Replace(Replace(Application.Trim(Join(Evaluate("IF(" & Rng.Address & "="""","""",SUBSTITUTE(" & Intersect(Rng.EntireColumn, Rows(1)).Address & ","" "",CHAR(1)))"), " ")), " ", Delimiter), Chr(1), " ")
End Function[/td]
[/tr]
[/table]