Concatenate anyone?

[dd]

Does anyone know how to:
Select a group of cells, say in a table column,
concatenate the contents (perhaps separated by commas)
and copy over to a cell selected in Sheet2?

I tried to record a macro to do this then install a RefEdit into the macro,
but I am a total bottom-eater at excel VBA.

Regards
Dylan Dawson
Scotland

 

[Bob Phillips]

Dim rng As Range
Dim cell as Range
Dim tmp As string

set rng = Application.InputBox("Select range with mouse",Type:=8)
If Not rng Is Nothing Then
For Each cell in rng
tmp = tmep & ","
Next cell
End If
Worksheets("Sheet2").Range("A1").value = _
Left(tmp,Len(tmp) - 1)

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[dd]

Bob,

Thanks for your assistance. This seems to follow through with what I wanted,
but the results are a bit weird. The target cell "A1" in this case displays
a series of dots depending on how many source cells I select i.e. three
cells selected then "..." appears in Sheet2.A1

Regards
Dylan Dawson

Sub ConcatAndMove()

Dim srcrng As Range
Dim tgtrng As Range
Dim cell As Range
Dim tmp As String

Set srcrng = Application.InputBox("Select range with mouse", Type:=8)
If Not srcrng Is Nothing Then
For Each cell In srcrng
tmp = tmp & ","
Next cell
End If
Set tgtrng = Application.InputBox("Select range with mouse", Type:=8)
tgtrng.Value = Left(tmp, Len(tmp) - 1)

End Sub

Dim rng As Range
Dim cell as Range
Dim tmp As string

set rng = Application.InputBox("Select range with mouse",Type:=8)
If Not rng Is Nothing Then
For Each cell in rng
tmp = tmep & ","
Next cell
End If
Worksheets("Sheet2").Range("A1").value = _
Left(tmp,Len(tmp) - 1)

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Bob Phillips]

Dylan,

My error sorry, I forgot an important bit.

I have corrected that, and also added code to deal with empty cells, so you
don't get repeated commas

Sub ConcatAndMove()

Dim srcrng As Range
Dim tgtrng As Range
Dim cell As Range
Dim tmp As String

Set srcrng = Application.InputBox("Select input range with mouse",
Type:=8)
If Not srcrng Is Nothing Then
For Each cell In srcrng
If Not cell.Value = "" Then tmp = tmp & cell.Value & ","
Next cell
End If
Set tgtrng = Application.InputBox("Select TARGET range with mouse",
Type:=8)
If tmp <> "" Then tgtrng.Value = Left(tmp, Len(tmp) - 1)

End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[dd]

Bob,

Excellent, thank you very much for your help.

--
Dylan


Dylan,

My error sorry, I forgot an important bit.

I have corrected that, and also added code to deal with empty cells, so you
don't get repeated commas

Sub ConcatAndMove()

Dim srcrng As Range
Dim tgtrng As Range
Dim cell As Range
Dim tmp As String

Set srcrng = Application.InputBox("Select input range with mouse",
Type:=8)
If Not srcrng Is Nothing Then
For Each cell In srcrng
If Not cell.Value = "" Then tmp = tmp & cell.Value & ","
Next cell
End If
Set tgtrng = Application.InputBox("Select TARGET range with mouse",
Type:=8)
If tmp <> "" Then tgtrng.Value = Left(tmp, Len(tmp) - 1)

End Sub


--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Mark Ivey]

Bob,

How would you modify this code to perform a concatenation on a table and
have it segregated by rows...

For instance:

Col 1 Col 2 Concatenated Result
www east www,east
www west www,west

 

[Bob Phillips]

This should do it

Sub ConcatAndMove()
Dim srcrng As Range
Dim tgtrng As Range
Dim oRow As Range
Dim cell As Range
Dim tmp As String

Set srcrng = Application.InputBox( _
"Select input range with mouse", Type:=8)
If Not srcrng Is Nothing Then
For Each oRow In srcrng.Rows
tmp = ""
For Each cell In oRow.Cells
If Not cell.Value = "" Then tmp = tmp & cell.Value & ","
Next cell
If tmp <> "" Then
oRow.Cells(1, oRow.Cells.Count).Offset(0, 1).Value =
Left(tmp, Len(tmp) - 1)
End If
Next oRow
End If
End Sub

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Mark Ivey]

Outstanding Bob...

Is there a good method in setting the starting TARGET position for this
code?

 

[Bob Phillips]

I have put it in the first free Coolum to the right of the selected area
Mark. What would you like, ask for every row, designate a column for all
rows, or maybe even a new row? let me know your preference.

--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Mark Ivey]

I would actually prefer to designate the column for the concatenation to
take place..

Is that a difficult change?

TIA...
Mark

 

[Bob Phillips]

No, the code is actually a tad simpler

Sub ConcatAndMove()
Dim srcrng As Range
Dim tgtrng As Range
Dim oRow As Range
Dim cell As Range
Dim tmp As String

Set srcrng = Application.InputBox( _
"Select input range with mouse", Type:=8)
Set tgtrng = Application.InputBox( _
"Select target column with mouse", Type:=8)
If Not srcrng Is Nothing Then
For Each oRow In srcrng.Rows
tmp = ""
For Each cell In oRow.Cells
If Not cell.Value = "" Then tmp = tmp & cell.Value & ","
Next cell
If tmp <> "" Then
Cells(oRow.Row, tgtrng.Column).Value = _
Left(tmp, Len(tmp) - 1)
End If
Next oRow
End If
End Sub



--
---
HTH

Bob

(change the xxxx to gmail if mailing direct)

 

[Mark Ivey]

Outstanding Bob...

I have been needing some code to do this function for quite a while now. I
just never got around to working on it or asking for help in this newsgroup.

Thanks a million...