How Multi Range CONCATENATE (UDF STRJOIN)

   Hi ! Here Suggest to you

[ Multi Range CONCATENATE ] Let's Look & Find    --->    Use - 1 STRJOIN (text1,text2,...)    Default JoinString = ,    Use - 2 STRJOIN (text1,text2,.... JoinString)

21  22  23  24  25  26  27  28  29  30  31  32  33  34  35  36  37

A B C D E A Dec/31/2008 / B 0.12   C F   D           A,Dec/31/2008,/,B,0.12,C,F,D        Join With "," Default String A,Dec/31/2008,/,B,C,D        Join With "," Default String A,Dec/31/2008,B,0.12,D,/        Join With "," Default String A/Dec/31/2008/B/0.12/D        Join With "/" User String A Dec/31/2008 B 0.12 D        Join With " " User String A , Dec/31/2008 , B , 0.12 , D        Join With " , " User String

Used Formula ...(With Running MicrosoftExcel Ver 2003)
No	Addr'	If use below Formula, You'll Get Result as Right	Result	Etc
1	A26	=STRJOIN(A21:E24)	A,Dec/31/2008,/,B,0.12,C,F,D
2	A28	=STRJOIN(21:21,A22:A24)	A,Dec/31/2008,/,B,C,D
3	A30	=STRJOIN(A21:C22,A24,E21)	A,Dec/31/2008,B,0.12,D,/
4	A32	=STRJOIN(A21:C22,A24,TEXT(E21,"#"))	A/Dec/31/2008/B/0.12/D
5	A34	=STRJOIN(A21:C22,A24," ")	A Dec/31/2008 B 0.12 D
6	A36	=STRJOIN(A21:C22,A24," , ")	A , Dec/31/2008 , B , 0.12 , D
How about this suggest?

Option Explicit

Function STRJOIN(ParamArray VariantR())
Dim i As Double, j As Double
Dim AddStr     As String
Dim MaxB       As Double
Dim AnsS()     As String
Dim ChkStrN    As Double
     MaxB = UBound(VariantR)

If TypeName(VariantR(MaxB)) = "Range" Then
     AddStr = Chr(65000) & "," & Chr(65000)
Else
     AddStr = Chr(65000) & VariantR(MaxB) & Chr(65000)
     MaxB = MaxB - 1
End If

ReDim AnsS(MaxB) As String
     ChkStrN = Len(AddStr)
Dim r As Range
For i = 0 To MaxB
     If TypeName(VariantR(i)) = "Range" Then
     If VariantR(i).Count > 1 Then
          Set r = VariantR(i)
          AnsS(i) = MVV(r, AddStr)
          Else
          AnsS(i) = VariantR(i)
          End If
     Else
          AnsS(i) = VariantR(i)
     End If
Next
     STRJOIN = Join(AnsS, AddStr)
If InStr(STRJOIN, AddStr) = 1 Then
STRJOIN = Mid(STRJOIN, ChkStrN + 1)
ElseIf Right(STRJOIN, ChkStrN) = AddStr Then
STRJOIN = Left(STRJOIN, Len(STRJOIN) - ChkStrN)
End If
     STRJOIN = Replace(STRJOIN, Chr(65000), "")
End Function

Function MVV(tmpV As Range, tmpStr As String)
Dim ii As Double
Dim jj As Double
Dim kk As Double
Dim LB1 As Double, LB2 As Double
Dim AnsY
LB1 = tmpV.Rows.Count
LB2 = tmpV.Columns.Count
ReDim AnsY(1 To 1)
     For ii = 1 To LB1
     For jj = 1 To LB2
          If CStr(tmpV(ii, jj)) <> "" Then
               kk = kk + 1
               ReDim Preserve AnsY(1 To kk)
               AnsY(kk) = tmpV(ii, jj).Text
          End If
     Next
     Next
MVV = Join(AnsY, tmpStr)
End Function
Any Bug Or Ask ... Mail Or Post Reply