ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   concentrate muli cells (https://www.excelbanter.com/excel-worksheet-functions/216354-concentrate-muli-cells.html)

Dylan @ UAFC[_2_]
concentrate muli cells
 
I need to concetrate 1000 cells
into one single cell seperated by , and space
please advise

Brotherharry
concentrate muli cells
 
On Jan 13, 5:15 pm, Dylan @ UAFC
wrote:
I need to concetrate 1000 cells
into one single cell seperated by , and space
please advise

Use Word search and replace if it's a one off!

JBeaucaire[_85_]
concentrate muli cells
 
You would need to add a new function to do this. Are you ok with using the
VBEditor?

Press Alt-F11
Click Insert Module
Paste in this code (sorry, it's a little long, be sure you get it all):

===========
Function StringConcat(Sep As String, ParamArray Args()) As String
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' StringConcat
' This function concatenates all the elements in the Args array,
' delimited by the Sep character, into a single string. This function
' can be used in an array formula.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
Dim S As String
Dim N As Long
Dim M As Long
Dim R As Range
Dim NumDims As Long
Dim LB As Long
Dim IsArrayAlloc As Boolean

'''''''''''''''''''''''''''''''''''''''''''
' If no parameters were passed in, return
' vbNullString.
'''''''''''''''''''''''''''''''''''''''''''
If UBound(Args) - LBound(Args) + 1 = 0 Then
StringConcat = vbNullString
Exit Function
End If


For N = LBound(Args) To UBound(Args)
''''''''''''''''''''''''''''''''''''''''''''''''
' Loop through the Args
''''''''''''''''''''''''''''''''''''''''''''''''
If IsObject(Args(N)) = True Then
'''''''''''''''''''''''''''''''''''''
' OBJECT
' If we have an object, ensure it
' it a Range. The Range object
' is the only type of object we'll
' work with. Anything else causes
' a #VALUE error.
''''''''''''''''''''''''''''''''''''
If TypeOf Args(N) Is Excel.Range Then
'''''''''''''''''''''''''''''''''''''''''
' If it is a Range, loop through the
' cells and create append the elements
' to the string S.
'''''''''''''''''''''''''''''''''''''''''
For Each R In Args(N).Cells
S = S & R.Text & Sep
Next R
Else
'''''''''''''''''''''''''''''''''
' Unsupported object type. Return
' a #VALUE error.
'''''''''''''''''''''''''''''''''
StringConcat = CVErr(xlErrValue)
Exit Function
End If

ElseIf IsArray(Args(N)) = True Then

On Error Resume Next
'''''''''''''''''''''''''''''''''''''
' ARRAY
' If Args(N) is an array, ensure it
' is an allocated array.
'''''''''''''''''''''''''''''''''''''
IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
(LBound(Args(N)) <= UBound(Args(N))))
On Error GoTo 0
If IsArrayAlloc = True Then
''''''''''''''''''''''''''''''''''''
' The array is allocated. Determine
' the number of dimensions of the
' array.
'''''''''''''''''''''''''''''''''''''
NumDims = 1
On Error Resume Next
Err.Clear
NumDims = 1
Do Until Err.Number < 0
LB = LBound(Args(N), NumDims)
If Err.Number = 0 Then
NumDims = NumDims + 1
Else
NumDims = NumDims - 1
End If
Loop
''''''''''''''''''''''''''''''''''
' The array must have either
' one or two dimensions. Greater
' that two caues a #VALUE error.
''''''''''''''''''''''''''''''''''
If NumDims 2 Then
StringConcat = CVErr(xlErrValue)
Exit Function
End If
If NumDims = 1 Then
For M = LBound(Args(N)) To UBound(Args(N))
If Args(N)(M) < vbNullString Then
S = S & Args(N)(M) & Sep
End If
Next M

Else
For M = LBound(Args(N), 1) To UBound(Args(N), 1)
If Args(N)(M, 1) < vbNullString Then
S = S & Args(N)(M, 1) & Sep
End If
Next M
For M = LBound(Args(N), 2) To UBound(Args(N), 2)
If Args(N)(M, 2) < vbNullString Then
S = S & Args(N)(M, 2) & Sep
End If
Next M

End If
Else
S = S & Args(N) & Sep
End If
Else
S = S & Args(N) & Sep
End If
Next N

'''''''''''''''''''''''''''''''''''
' Remove the trailing Sep character
'''''''''''''''''''''''''''''''''''
If Len(Sep) 0 Then
S = Left(S, Len(S) - Len(Sep))
End If

StringConcat = S

End Function
===========

The code is also available he
http://www.cpearson.com/excel/stringconcatenation.aspx

Press Alt-Q to close the editor and save your sheet. You've just added a
function called StringConcat() to your sheet and it works very simply.

If your 1000 cells are range A1:A1000, use this formula in another cell:

=StringConcat(", ",A1:A1000)

Voila! Works like a charm. Will that work for you?
--
"Actually, I AM a rocket scientist." -- JB

Your feedback is appreciated, click YES if this post helped you.


"Dylan @ UAFC" wrote:

I need to concetrate 1000 cells
into one single cell seperated by , and space
please advise

Gord Dibben
concentrate muli cells
 
Add this UDF to a general module.

Function ConCatRange(CellBlock As Range) As String
Dim Cell As Range
Dim sbuf As String
For Each Cell In CellBlock
If Len(Cell.text) 0 Then sbuf = sbuf & Cell.text & ", "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=concatrange(A1:A1000)


Gord Dibben MS Excel MVP

On Tue, 13 Jan 2009 09:15:01 -0800, Dylan @ UAFC
wrote:

I need to concetrate 1000 cells
into one single cell seperated by , and space
please advise


JBeaucaire[_85_]
concentrate muli cells
 
That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.
--
"Actually, I AM a rocket scientist." -- JB

Your feedback is appreciated, click YES if this post helped you.


"Gord Dibben" wrote:

Add this UDF to a general module.

Function ConCatRange(CellBlock As Range) As String
Dim Cell As Range
Dim sbuf As String
For Each Cell In CellBlock
If Len(Cell.text) 0 Then sbuf = sbuf & Cell.text & ", "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=concatrange(A1:A1000)


Gord Dibben MS Excel MVP

Mike H
concentrate muli cells
 
If Gord will excuse me playing with his code then you do it like this.
Delimeter is optional. you enter your own or if you leave it the default
comma is used

=concatrange(A1:A100,"-")

or

=concatrange(A1:A100)



Function ConCatRange(CellBlock As Range, _
Optional delimeter As String) As String
If delimeter = "" Then delimeter = ","
Dim Cell As Range
Dim sbuf As String
For Each Cell In CellBlock
If Len(Cell.Text) 0 Then sbuf = sbuf & Cell.Text & delimeter
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

Mike

"JBeaucaire" wrote:

That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.
--
"Actually, I AM a rocket scientist." -- JB

Your feedback is appreciated, click YES if this post helped you.


"Gord Dibben" wrote:

Add this UDF to a general module.

Function ConCatRange(CellBlock As Range) As String
Dim Cell As Range
Dim sbuf As String
For Each Cell In CellBlock
If Len(Cell.text) 0 Then sbuf = sbuf & Cell.text & ", "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=concatrange(A1:A1000)


Gord Dibben MS Excel MVP

Dave Peterson
concentrate muli cells
 
Option Explicit
Function ConCatRange(CellBlock As Range, Optional Delim As String = "") _
As String

Dim Cell As Range
Dim sbuf As String

For Each Cell In CellBlock.Cells
If Cell.Text < "" Then
sbuf = sbuf & Cell.Text & Delim
End If
Next Cell

ConCatRange = Left(sbuf, Len(sbuf) - Len(Delim))

End Function

(With minor variations to Gord's code--just to be different!)

=ConcatRange(A1:A1000, ", ")
or
=ConcatRange(A1:A1000, "")
or even
=ConcatRange(A1:A1000)


JBeaucaire wrote:

That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.
--
"Actually, I AM a rocket scientist." -- JB

Your feedback is appreciated, click YES if this post helped you.

"Gord Dibben" wrote:

Add this UDF to a general module.

Function ConCatRange(CellBlock As Range) As String
Dim Cell As Range
Dim sbuf As String
For Each Cell In CellBlock
If Len(Cell.text) 0 Then sbuf = sbuf & Cell.text & ", "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=concatrange(A1:A1000)


Gord Dibben MS Excel MVP

--

Dave Peterson

Dylan @ UAFC[_2_]
concentrate muli cells
 
looked scary, but worked like a charm

"Gord Dibben" wrote:

Add this UDF to a general module.

Function ConCatRange(CellBlock As Range) As String
Dim Cell As Range
Dim sbuf As String
For Each Cell In CellBlock
If Len(Cell.text) 0 Then sbuf = sbuf & Cell.text & ", "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=concatrange(A1:A1000)


Gord Dibben MS Excel MVP

On Tue, 13 Jan 2009 09:15:01 -0800, Dylan @ UAFC
wrote:

I need to concetrate 1000 cells
into one single cell seperated by , and space
please advise



Gord Dibben
concentrate muli cells
 
I like the improvement Dave.

Gord

On Tue, 13 Jan 2009 14:42:04 -0600, Dave Peterson
wrote:

Option Explicit
Function ConCatRange(CellBlock As Range, Optional Delim As String = "") _
As String

Dim Cell As Range
Dim sbuf As String

For Each Cell In CellBlock.Cells
If Cell.Text < "" Then
sbuf = sbuf & Cell.Text & Delim
End If
Next Cell

ConCatRange = Left(sbuf, Len(sbuf) - Len(Delim))

End Function

(With minor variations to Gord's code--just to be different!)

=ConcatRange(A1:A1000, ", ")
or
=ConcatRange(A1:A1000, "")
or even
=ConcatRange(A1:A1000)


JBeaucaire wrote:

That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.
--
"Actually, I AM a rocket scientist." -- JB

Your feedback is appreciated, click YES if this post helped you.

"Gord Dibben" wrote:

Add this UDF to a general module.

Function ConCatRange(CellBlock As Range) As String
Dim Cell As Range
Dim sbuf As String
For Each Cell In CellBlock
If Len(Cell.text) 0 Then sbuf = sbuf & Cell.text & ", "
Next
ConCatRange = Left(sbuf, Len(sbuf) - 1)
End Function

=concatrange(A1:A1000)


Gord Dibben MS Excel MVP

Gord Dibben
concentrate muli cells
 
See Dave's improved version of the UDF

Note the UDF will not accept non-contiguous ranges.

For non-contiguous cells or ranges you can use this macro.

Sub ConCat_Cells()
Dim X As Range
Dim y As Range
Dim Z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter(s) Desired")
Set Z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set X = Application.InputBox("Select Cells, Contiguous or _
Non-Contiguous", _
"Cells Selection", , , , , , 8)
For Each y In X
If Len(y.text) 0 Then sbuf = sbuf & y.text & w
Next
Z = Left(sbuf, Len(sbuf) - Len(w))
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub


Gord
On Tue, 13 Jan 2009 12:06:08 -0800, JBeaucaire
wrote:

That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.

Dave Peterson
concentrate muli cells
 
But by changing it to a subroutine from a function, the ability to use it in a
formula in a worksheet cell is lost.

But you could pass the range (in a infrequently used) syntax:

=ConCatRange((A1:A10,B3:B5),", ")

Those inside ()'s and comma are necessary.



Gord Dibben wrote:

See Dave's improved version of the UDF

Note the UDF will not accept non-contiguous ranges.

For non-contiguous cells or ranges you can use this macro.

Sub ConCat_Cells()
Dim X As Range
Dim y As Range
Dim Z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter(s) Desired")
Set Z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set X = Application.InputBox("Select Cells, Contiguous or _
Non-Contiguous", _
"Cells Selection", , , , , , 8)
For Each y In X
If Len(y.text) 0 Then sbuf = sbuf & y.text & w
Next
Z = Left(sbuf, Len(sbuf) - Len(w))
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub

Gord
On Tue, 13 Jan 2009 12:06:08 -0800, JBeaucaire
wrote:

That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.

--

Dave Peterson

Dylan @ UAFC[_2_]
concentrate muli cells
 
is there a charcter max in this formula

"JBeaucaire" wrote:

You would need to add a new function to do this. Are you ok with using the
VBEditor?

Press Alt-F11
Click Insert Module
Paste in this code (sorry, it's a little long, be sure you get it all):

===========
Function StringConcat(Sep As String, ParamArray Args()) As String
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' StringConcat
' This function concatenates all the elements in the Args array,
' delimited by the Sep character, into a single string. This function
' can be used in an array formula.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
Dim S As String
Dim N As Long
Dim M As Long
Dim R As Range
Dim NumDims As Long
Dim LB As Long
Dim IsArrayAlloc As Boolean

'''''''''''''''''''''''''''''''''''''''''''
' If no parameters were passed in, return
' vbNullString.
'''''''''''''''''''''''''''''''''''''''''''
If UBound(Args) - LBound(Args) + 1 = 0 Then
StringConcat = vbNullString
Exit Function
End If


For N = LBound(Args) To UBound(Args)
''''''''''''''''''''''''''''''''''''''''''''''''
' Loop through the Args
''''''''''''''''''''''''''''''''''''''''''''''''
If IsObject(Args(N)) = True Then
'''''''''''''''''''''''''''''''''''''
' OBJECT
' If we have an object, ensure it
' it a Range. The Range object
' is the only type of object we'll
' work with. Anything else causes
' a #VALUE error.
''''''''''''''''''''''''''''''''''''
If TypeOf Args(N) Is Excel.Range Then
'''''''''''''''''''''''''''''''''''''''''
' If it is a Range, loop through the
' cells and create append the elements
' to the string S.
'''''''''''''''''''''''''''''''''''''''''
For Each R In Args(N).Cells
S = S & R.Text & Sep
Next R
Else
'''''''''''''''''''''''''''''''''
' Unsupported object type. Return
' a #VALUE error.
'''''''''''''''''''''''''''''''''
StringConcat = CVErr(xlErrValue)
Exit Function
End If

ElseIf IsArray(Args(N)) = True Then

On Error Resume Next
'''''''''''''''''''''''''''''''''''''
' ARRAY
' If Args(N) is an array, ensure it
' is an allocated array.
'''''''''''''''''''''''''''''''''''''
IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
(LBound(Args(N)) <= UBound(Args(N))))
On Error GoTo 0
If IsArrayAlloc = True Then
''''''''''''''''''''''''''''''''''''
' The array is allocated. Determine
' the number of dimensions of the
' array.
'''''''''''''''''''''''''''''''''''''
NumDims = 1
On Error Resume Next
Err.Clear
NumDims = 1
Do Until Err.Number < 0
LB = LBound(Args(N), NumDims)
If Err.Number = 0 Then
NumDims = NumDims + 1
Else
NumDims = NumDims - 1
End If
Loop
''''''''''''''''''''''''''''''''''
' The array must have either
' one or two dimensions. Greater
' that two caues a #VALUE error.
''''''''''''''''''''''''''''''''''
If NumDims 2 Then
StringConcat = CVErr(xlErrValue)
Exit Function
End If
If NumDims = 1 Then
For M = LBound(Args(N)) To UBound(Args(N))
If Args(N)(M) < vbNullString Then
S = S & Args(N)(M) & Sep
End If
Next M

Else
For M = LBound(Args(N), 1) To UBound(Args(N), 1)
If Args(N)(M, 1) < vbNullString Then
S = S & Args(N)(M, 1) & Sep
End If
Next M
For M = LBound(Args(N), 2) To UBound(Args(N), 2)
If Args(N)(M, 2) < vbNullString Then
S = S & Args(N)(M, 2) & Sep
End If
Next M

End If
Else
S = S & Args(N) & Sep
End If
Else
S = S & Args(N) & Sep
End If
Next N

'''''''''''''''''''''''''''''''''''
' Remove the trailing Sep character
'''''''''''''''''''''''''''''''''''
If Len(Sep) 0 Then
S = Left(S, Len(S) - Len(Sep))
End If

StringConcat = S

End Function
===========

The code is also available he
http://www.cpearson.com/excel/stringconcatenation.aspx

Press Alt-Q to close the editor and save your sheet. You've just added a
function called StringConcat() to your sheet and it works very simply.

If your 1000 cells are range A1:A1000, use this formula in another cell:

=StringConcat(", ",A1:A1000)

Voila! Works like a charm. Will that work for you?
--
"Actually, I AM a rocket scientist." -- JB

Your feedback is appreciated, click YES if this post helped you.


"Dylan @ UAFC" wrote:

I need to concetrate 1000 cells
into one single cell seperated by , and space
please advise

Gord Dibben
concentrate muli cells
 
I never knew that<g

The extra parens are what makes it work.

Just keep on learnin'


Gord

On Tue, 13 Jan 2009 18:42:05 -0600, Dave Peterson
wrote:

But by changing it to a subroutine from a function, the ability to use it in a
formula in a worksheet cell is lost.

But you could pass the range (in a infrequently used) syntax:

=ConCatRange((A1:A10,B3:B5),", ")

Those inside ()'s and comma are necessary.



Gord Dibben wrote:

See Dave's improved version of the UDF

Note the UDF will not accept non-contiguous ranges.

For non-contiguous cells or ranges you can use this macro.

Sub ConCat_Cells()
Dim X As Range
Dim y As Range
Dim Z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter(s) Desired")
Set Z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set X = Application.InputBox("Select Cells, Contiguous or _
Non-Contiguous", _
"Cells Selection", , , , , , 8)
For Each y In X
If Len(y.text) 0 Then sbuf = sbuf & y.text & w
Next
Z = Left(sbuf, Len(sbuf) - Len(w))
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub

Gord
On Tue, 13 Jan 2009 12:06:08 -0800, JBeaucaire
wrote:

That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.

Dave Peterson
concentrate muli cells
 
And those are easy to forget, too!

Gord Dibben wrote:

I never knew that<g

The extra parens are what makes it work.

Just keep on learnin'

Gord

On Tue, 13 Jan 2009 18:42:05 -0600, Dave Peterson
wrote:

But by changing it to a subroutine from a function, the ability to use it in a
formula in a worksheet cell is lost.

But you could pass the range (in a infrequently used) syntax:

=ConCatRange((A1:A10,B3:B5),", ")

Those inside ()'s and comma are necessary.



Gord Dibben wrote:

See Dave's improved version of the UDF

Note the UDF will not accept non-contiguous ranges.

For non-contiguous cells or ranges you can use this macro.

Sub ConCat_Cells()
Dim X As Range
Dim y As Range
Dim Z As Range
Dim w As String
Dim sbuf As String
On Error GoTo endit
w = InputBox("Enter the Type of De-limiter(s) Desired")
Set Z = Application.InputBox("Select Destination Cell", _
"Destination Cell", , , , , , 8)
Application.SendKeys "+{F8}"
Set X = Application.InputBox("Select Cells, Contiguous or _
Non-Contiguous", _
"Cells Selection", , , , , , 8)
For Each y In X
If Len(y.text) 0 Then sbuf = sbuf & y.text & w
Next
Z = Left(sbuf, Len(sbuf) - Len(w))
Exit Sub
endit:
MsgBox "Nothing Selected. Please try again."
End Sub

Gord
On Tue, 13 Jan 2009 12:06:08 -0800, JBeaucaire
wrote:

That is wonderfully concise. Is there any way to add an argument so the
delimiters (if any) are added in the user function?

=ConcatRange(", ",A1:A1000)

I would love to use the briefer version, but I need to retain the ability to
define the delimiter or use no delimiter at all.

Thanks.

--

Dave Peterson

[email protected]
concentrate muli cells
 
What if I wanted to use this in an if formual
tbl array or range would have an office name in col C, email address in Col
F
Say Dallas, Austin and Seatlle
The email address that need to consolidated are in col f
I would like to set up were
if(-- the range col c -- $c$1:$c$500="office name" -- considate all the
email
address in col F associated with that office name, delimiter "; ")

Please advise

"JBeaucaire" wrote:

You would need to add a new function to do this. Are you ok with using the
VBEditor?

Press Alt-F11
Click Insert Module
Paste in this code (sorry, it's a little long, be sure you get it all):

===========
Function StringConcat(Sep As String, ParamArray Args()) As String
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
' StringConcat
' This function concatenates all the elements in the Args array,
' delimited by the Sep character, into a single string. This function
' can be used in an array formula.
'''''''''''''''''''''''''''''''''''''''''''''''''' ''''''''''''''''''''''
Dim S As String
Dim N As Long
Dim M As Long
Dim R As Range
Dim NumDims As Long
Dim LB As Long
Dim IsArrayAlloc As Boolean

'''''''''''''''''''''''''''''''''''''''''''
' If no parameters were passed in, return
' vbNullString.
'''''''''''''''''''''''''''''''''''''''''''
If UBound(Args) - LBound(Args) + 1 = 0 Then
StringConcat = vbNullString
Exit Function
End If


For N = LBound(Args) To UBound(Args)
''''''''''''''''''''''''''''''''''''''''''''''''
' Loop through the Args
''''''''''''''''''''''''''''''''''''''''''''''''
If IsObject(Args(N)) = True Then
'''''''''''''''''''''''''''''''''''''
' OBJECT
' If we have an object, ensure it
' it a Range. The Range object
' is the only type of object we'll
' work with. Anything else causes
' a #VALUE error.
''''''''''''''''''''''''''''''''''''
If TypeOf Args(N) Is Excel.Range Then
'''''''''''''''''''''''''''''''''''''''''
' If it is a Range, loop through the
' cells and create append the elements
' to the string S.
'''''''''''''''''''''''''''''''''''''''''
For Each R In Args(N).Cells
S = S & R.Text & Sep
Next R
Else
'''''''''''''''''''''''''''''''''
' Unsupported object type. Return
' a #VALUE error.
'''''''''''''''''''''''''''''''''
StringConcat = CVErr(xlErrValue)
Exit Function
End If

ElseIf IsArray(Args(N)) = True Then

On Error Resume Next
'''''''''''''''''''''''''''''''''''''
' ARRAY
' If Args(N) is an array, ensure it
' is an allocated array.
'''''''''''''''''''''''''''''''''''''
IsArrayAlloc = (Not IsError(LBound(Args(N))) And _
(LBound(Args(N)) <= UBound(Args(N))))
On Error GoTo 0
If IsArrayAlloc = True Then
''''''''''''''''''''''''''''''''''''
' The array is allocated. Determine
' the number of dimensions of the
' array.
'''''''''''''''''''''''''''''''''''''
NumDims = 1
On Error Resume Next
Err.Clear
NumDims = 1
Do Until Err.Number < 0
LB = LBound(Args(N), NumDims)
If Err.Number = 0 Then
NumDims = NumDims + 1
Else
NumDims = NumDims - 1
End If
Loop
''''''''''''''''''''''''''''''''''
' The array must have either
' one or two dimensions. Greater
' that two caues a #VALUE error.
''''''''''''''''''''''''''''''''''
If NumDims 2 Then
StringConcat = CVErr(xlErrValue)
Exit Function
End If
If NumDims = 1 Then
For M = LBound(Args(N)) To UBound(Args(N))
If Args(N)(M) < vbNullString Then
S = S & Args(N)(M) & Sep
End If
Next M

Else
For M = LBound(Args(N), 1) To UBound(Args(N), 1)
If Args(N)(M, 1) < vbNullString Then
S = S & Args(N)(M, 1) & Sep
End If
Next M
For M = LBound(Args(N), 2) To UBound(Args(N), 2)
If Args(N)(M, 2) < vbNullString Then
S = S & Args(N)(M, 2) & Sep
End If
Next M

End If
Else
S = S & Args(N) & Sep
End If
Else
S = S & Args(N) & Sep
End If
Next N

'''''''''''''''''''''''''''''''''''
' Remove the trailing Sep character
'''''''''''''''''''''''''''''''''''
If Len(Sep) 0 Then
S = Left(S, Len(S) - Len(Sep))
End If

StringConcat = S

End Function
===========

The code is also available he
http://www.cpearson.com/excel/stringconcatenation.aspx

Press Alt-Q to close the editor and save your sheet. You've just added a
function called StringConcat() to your sheet and it works very simply.

If your 1000 cells are range A1:A1000, use this formula in another cell:

=StringConcat(", ",A1:A1000)

Voila! Works like a charm. Will that work for you?
--
"Actually, I AM a rocket scientist." -- JB

Your feedback is appreciated, click YES if this post helped you.


"Dylan @ UAFC" wrote:

I need to concetrate 1000 cells
into one single cell seperated by , and space
please advise


All times are GMT +1. The time now is 09:05 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com