Solved: VBA for Concatenate

Hi,

I was wondering if I could use the concatenate formula within VBA.

What I'd like to do is add a menu option so that with one click the highlighted range, say cells A1,A2 and A3 can concatenate into cell A1.

Is this possible ? :think:

Many thanks

This procedure will concatenate each cell in the selection and the next column

[vba]

Private Sub JoinColumns()
Dim iLastCol As Long
Dim cell As Range
Dim j As Long
For Each cell In Selection
With cell
.Value = .Value & " " & .Offset(0, 1).Value
.Offset(0, 1).Value = ""
iLastCol = Cells(.Row, Columns.Count).End(xlToLeft).Column
For j = .Column + 1 To iLastCol - 1
Cells(.Row, j).Value = Cells(.Row, j + 1).Value
Cells(.Row, j + 1).Value = ""
Next j
End With
Next cell
End Sub
[/vba]

Hi, thanks for this.

It doesn't seem to concatenate the rows though. I'm trying to concatenate E15,16 and 17 but nothing happens.
Do I need to alter the script ?

Select E16, then run the macro. Then run it again.

Hi again,

I still can't seem to get it to work, I must be doing something wrong! :doh:

All I have on my spreadsheet is text in cells E15, E16 & E17. When I highlight the range and run the macro nothing happens.
It does work if I have the text in E15, F15 & G15 but I need the not working option.

Hope you can help, many thanks.

Try this adaptation

[vba]

Public Sub JoinData()
Dim NumRows As Long
Dim NumCols As Long
Dim LastCol As Long
Dim cell As Range
Dim tmp As String
Dim j As Long

NumRows = Selection.Rows.Count
NumCols = Selection.Columns.Count

If NumCols = 1 Then

For j = 1 To NumRows

tmp = tmp & Selection.Cells(j, 1).Value & " "
Next j

Selection.Value = ""
Selection.Cells(1, 1).Value = Trim(tmp)
Else

For Each cell In Selection.Columns(1).Cells

tmp = ""
With cell

LastCol = Cells(.Row, Columns.Count).End(xlToLeft).Column
For j = .Column To LastCol

tmp = tmp & Cells(.Row, j).Value & " "
Next j

Cells(.Row, .Column).Resize(1, LastCol - .Column + 1).Value = ""
Cells(.Row, .Column).Value = Trim(tmp)
End With
Next cell
End If
End Sub
[/vba]

Brilliat. Works a treat , thanks so much :thumb

[vba]Sub kTest()
Dim s As String, i As Long, a, Flg As Boolean
With Selection
If .Columns.Count = 1 Then
Flg = True
s = Trim(Join$(Application.Transpose(.Value), " "))
Else
a = .Value
For i = 1 To UBound(a, 2)
s = s & " " & Join$(Application.Transpose(Application.Index(a, 0, i)), " ")
Next
End If
.ClearContents
.Cells(1, 1).Value = IIf(Flg, s, Trim(Mid$(s, 2)))
End With
End Sub[/vba]