Merging text from selected range of cell

[ATan]

I know the concatenate function is able to merge the text from the range of selected cells but I would like to enhance this function to suit my needs.

I have a old document that have the text entry for a single block of text broken up into various cells. I would like to pull into a single cell this block of text that is spread across a few cells. I need to ensure that a space is automatically place in between the text from 2 cells so the text can be readable. Using the concatenate function can achieve the same result. Is there a better way.

=concatenate(A1," ",A2)

[Bob Phillips]

[vba]

Function ConCat(rng As Range)
Dim cell As Range
Dim tmp s String

For Each cell In rng

tmp = tmp & cell.Value & " "
Next cell

tmp = Left(tmp, Len(tmp) -1)
End Function
[/vba]

[ATan]

xld,

I tried the codes but the result is a shown as a zero. By the way I have noticed the error of the missing a in As in the code, "Dim tmp As String". Correcting this do not change the result.

[Bob Phillips]

Can you post some sample data/workbook then?

[Benzadeus]

Try changing
[VBA]tmp = Left(tmp, Len(tmp) -1)[/VBA]

to
[VBA]ConCat = Left(tmp, Len(tmp) -1)[/VBA]

[Bob Phillips]

Ah yes, I see I missed a line

[vba]

Function ConCat(rng As Range)
Dim cell As Range
Dim tmp s String

For Each cell In rng

tmp = tmp & cell.Value & " "
Next cell

tmp = Left(tmp, Len(tmp) -1)

ConCat = tmp
End Function
[/vba]

[BackJack]

Atan,
Here is a possible solution that I use to get client names from a spreadsheet for a form. It could be modified to be used anywhere.

[VBA]Public Function GetClientName(ClientRow As Long) As String
Dim tmpname As String

If Len(Sheets("Sheet1").Cells(ClientRow, 9)) > 0 And _
Len(Sheets("Sheet1").Cells(ClientRow, 10)) > 0 And _
Len(Sheets("Sheet1").Cells(ClientRow, 11)) > 0 Then

tmpname = Sheets("Sheet1").Cells(ClientRow, 9) & " " _
& Sheets("Sheet1").Cells(ClientRow, 10) & " " _
& Sheets("Sheet1").Cells(ClientRow, 11)

ElseIf Len(Sheets("Sheet1").Cells(ClientRow, 9)) > 0 And _
Len(Sheets("Sheet1").Cells(ClientRow, 11)) > 0 Then

tmpname = Sheets("Sheet1").Cells(ClientRow, 9) & " " _
& Sheets("Sheet1").Cells(ClientRow, 11)
Else
tmpname = ""
End If

GetClientName = tmpname
End Function[/VBA]

[ATan]

Guys,

The changes made the codes to work as desire. Thanks guys.

[ATan]

After trying out the UDF and I noticed that it will works fine as long as the selected range is a contiguous range of cells. But if there is a break the result will shown as a #Value! error message. Is there anything can be done so that this UDF can work even if the selected range of cells is non contiguous?

[Bob Phillips]

[vba]

Function ConCat(ParamArray rng())
Dim cell As Range
Dim tmp As String
Dim i As Long

For i = LBound(rng) To UBound(rng)

For Each cell In rng(i)

tmp = tmp & cell.Value & " "
Next cell
Next i

tmp = Left(tmp, Len(tmp) - 1)
ConCat = tmp
End Function
[/vba]

[ATan]

Xld,

You are a saviour. Thanks

[ATan]

Xld,

Alas! An error was encountered while running the codes. The message said, "Compile error : expected array". This part of the codes was highlighted

For i = LBound(rng) To UBound(rng)

[ATan]

xld,

It ok now. I discover the mistake I made. I did not change this part of the code. It should be "Function ConCat(ParamArray rng()).

[mdmackillop]

To avoid double spaces in the output
[VBA]
For i = LBound(rng) To UBound(rng)
For Each cell In rng(i)
tmp = Trim(tmp & cell.Value) & " "
Next cell
Next i
ConCat = Trim(tmp)

[/VBA]

[mikerickson]

I keep the UDF ConcatIf on hand. The first three arguments mirror the arguments of SUMIF. The optional arguments Delimiter and NoDuplicates are (hopefully) self-explainitory.
For the situation you describe, I'd use the formula
=ConcatIf(A1:A10,"<>",A1:A10," ")

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
    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

[Bob Phillips]

Doesn't handle a dis-contiguous range as required by the OP.

[mikerickson]

True.