VBA or FORMULA for have the list of words in a range

[samuele2723]

HelloFolks,<o></o>
Situation isthis:<o></o>
<o></o>
I have acolumn with a list of words butsometimes cells empty.<o></o>
I want asoutput in a big cell all the words listed, but skipping blanks.<o></o>
<o></o>
Since now Idid everything concatenating in alternate sequence my words column and a columnwith this code:<o></o>
<o></o>

[FONT=Calibri][SIZE=3][COLOR=#000000]=IF(NOT(WORDCELL="");CHAR(10);"")<o:p></o:p>[/COLOR][/SIZE][/FONT]

<o></o>
<o> Everything was fine but now I have a list of 1000 cells and using this technique the function CONCATENATE tells me that I am using too many arguments because I am not concatenating ranges but cell by cell divided in arguments as it is alternate<o></o></o>

[FONT=Calibri][SIZE=3][COLOR=#000000]=CONCATENATE(CH22;CG23;CH23;CG24;CH24;CG25;CH25;CG26;CH26;CG27;CH27;CG28;CH28;CG29;CH29;CG30;CH30;CG31;CH31;CG32;CH32;CG33;CH33;CG34;CH34;CG35;CH35;CG36;CH36;CG37;CH37;CG38;CH38;CG39;CH39;CG40;CH40;CG41;CH41;CG42;CH42;CG43;CH43;CG44;CH44;CG45;CH45;CG46;CH46;CG47;CH47;CG48;CH48;CG49;CH49;CG50;CH50;CG51;CH51;CG52;CH52;CG53;CH53;CG54;CH54;CG55;CH55;CG56;CH56;CG57;CH57;CG58;CH58;CG59;CH59;CG60;CH60;CG61;CH61;CG62;CH62;CG63;CH63;CG64;CH64;CG65;CH65;CG66;CH66;CG67;CH67;CG68;CH68;CG69;CH69;CG70;CH70;CG71;CH71;CG72;CH72;CG73;CH73;CG74;CH74;CG75;CH75;CG76;CH76;CG77;CH77;CG78;CH78;CG79;CH79;CG80;CH80;CG81;CH81;CG82;CH82;CG83;CH83;CG84;CH84;CG85;CH85;CG86;CH86;CG87;CH87;CG88;CH88;CG89;CH89;CG90;CH90;CG91;CH91;CG92;CH92;CG93;CH93;CG94;CH94;CG95;CH95;CG96;CH96;CG97;CH97;CG98;CH98;CG99;CH99;CG100;CH100;CG101;CH101;CG102;CH102;CG103;CH103;CG104;CH104;CG105;CH105;CG106;CH106;CG107;CH107;CG108;CH108;CG109;CH109;CG110;CH110;CG111;CH111;CG112;CH112;CG113;CH113;CG114;CH114;CG115;CH115;CG116;CH116;CG117;CH117;CG118;CH118;CG119;CH119;CG120;CH120;CG121;CH121;CG122)<o:p></o:p>[/COLOR][/SIZE][/FONT]
<o:p></o:p>

<o></o>
<o> So now my question is…<o></o></o>
Is possibleto have same result concatenating range some way?<o></o>
<o></o><o></o>
OR<o></o>
<o></o><o></o>
Is there analternative solution for having the list of words, skipping blanks, in theoutput cell without using this technique?<o></o>
<o></o>
Thanks<o></o>

 

[CharlesChuckieCharles]

a couple of points to be aware of


A cell can hold 64K characters, but will only display the first 1024 characters in the cell, you would have to use the formula bar to read more of the cell content

The following macro is a function ( which doesn't have the Concatenate limitation) but the CELL limits

Use like =Myconcate(A1:AZ10000)

or =Myconcate(A1:AZ10000,":") for the spacer character option



insert a module in the VBA interface and paste in the following code

Function Myconcate(rngRange As Range, Optional myspacer As String) As String
Dim MyResult As String
Dim MyCell As Range
MyResult = ""
For Each MyCell In rngRange
    If Trim(MyCell.Value) <> "" Then
        If Len(myspacer) <> 0 Then
            MyResult = MyResult & IIf(MyResult = "", "", myspacer) & MyCell.Value
        Else
            MyResult = MyResult & MyCell.Value
        End If
        
    End If
    
    DoEvents
        
Next MyCell
Myconcate = MyResult
End Function

 

[SteveO59L]

Dim c As Range, rng
Dim val1 As String

Set rng = Range("a1:a1000")
For Each c In rng
If c.Value <> "" Then
val1 = val1 & c.Value & ";"
End If
Next c
Range("c1") = val1

 

[samuele2723]

a couple of points to be aware of


A cell can hold 64K characters, but will only display the first 1024 characters in the cell, you would have to use the formula bar to read more of the cell content

The following macro is a function ( which doesn't have the Concatenate limitation) but the CELL limits

Use like =Myconcate(A1:AZ10000)

or =Myconcate(A1:AZ10000,":") for the spacer character option



insert a module in the VBA interface and paste in the following code

Function Myconcate(rngRange As Range, Optional myspacer As String) As String
Dim MyResult As String
Dim MyCell As Range
MyResult = ""
For Each MyCell In rngRange
    If Trim(MyCell.Value) <> "" Then
        If Len(myspacer) <> 0 Then
            MyResult = MyResult & IIf(MyResult = "", "", myspacer) & MyCell.Value
        Else
            MyResult = MyResult & MyCell.Value
        End If
        
    End If
    
    DoEvents
        
Next MyCell
Myconcate = MyResult
End Function

thanks for the reply. Your solution seems fine but i still have the problem that i want to have a list and not a sequence of words. i would need to "return" instead ":" as a separator. is this possible?

 

[samuele2723]

Dim c As Range, rng
Dim val1 As String

Set rng = Range("a1:a1000")
For Each c In rng
If c.Value <> "" Then
val1 = val1 & c.Value & ";"
End If
Next c
Range("c1") = val1

Hello Steve, thanks for your reply. As i was mentioning to the other expert, i would need a list so would be possible with your code to "return" insted of ";"? Thanks

 

[SteveO59L]

Dim c As Range, rng
Dim val1 As String

Set rng = Range("a1:a1000")
For Each c In rng
If c.Value <> "" Then
val1 = val1 & c.Value & Chr(10)
End If
Next c
Sheets("sheet2").Activate
Range("a1") = val1

 

[CharlesChuckieCharles]

This replaces the previous function

using the spacer as "CHR(10)" will cause it to issue line returns


BUT you have to set the Cell that contains the function to WRAPTEXT = true

if appears that excel won't let a function change that setting on a cell

Function Myconcate(rngRange As Range, Optional MySpacer As Variant) As Variant
Dim MyResult As Variant
Dim MyCell As Range
MyResult = ""
For Each MyCell In rngRange
    If Trim(MyCell.Value) <> "" Then
        If Len(MySpacer) <> 0 Then
            MyResult = MyResult & IIf(MyResult = "", "", IIf(UCase(MySpacer) = "CHR(10)", Chr(10) & Chr(13), MySpacer)) & MyCell.Value
        Else
            MyResult = MyResult & MyCell.Value
        End If
        
    End If
    
    DoEvents
        
Next MyCell
'If MySpacer = "CHR(10)" Then
'Parent.ThisCell.WrapText = True
'Range(Parent.ThisCell.Address).WrapText = True
'            .HorizontalAlignment = xlGeneral
'            .VerticalAlignment = xlBottom
'            .WrapText = True
'            .Orientation = 0
'            .AddIndent = False
'            .IndentLevel = 0
'            .ShrinkToFit = False
'            .ReadingOrder = xlContext
'            .MergeCells = False
'    End With
'End If
 

Myconcate = MyResult
End Function

 

[samuele2723]

Dim c As Range, rng
Dim val1 As String

Set rng = Range("a1:a1000")
For Each c In rng
If c.Value <> "" Then
val1 = val1 & c.Value & Chr(10)
End If
Next c
Sheets("sheet2").Activate
Range("a1") = val1

Steve, this worked just great! What if i would also have a "- " before the word and a ";" after it? so it is a complete bulletlist! Thanks a lot

 

[SteveO59L]

Dim c As Range, rng
Dim val1 As String

Set rng = Range("a1:a1000")
For Each c In rng
If c.Value <> "" Then
val1 = val1 & "-" & c.Value & Chr(10) & ";"
End If
Next c
Sheets("sheet2").Activate
Range("a1") = val1

 

[samuele2723]

Dim c As Range, rng
Dim val1 As String

Set rng = Range("a1:a1000")
For Each c In rng
If c.Value <> "" Then
val1 = val1 & "-" & c.Value & Chr(10) & ";"
End If
Next c
Sheets("sheet2").Activate
Range("a1") = val1

OK code works great for one.
Only thing is that i am trying to have 3x of them working in different ranges and i get error about “duplicate declaration in current scope” when i do

Private Sub Worksheet_Change(ByVal Target As Range)
 
    Application.EnableEvents = False
 
     If Not Intersect(Target, Range("BP22:BP1020")) Is Nothing Then
        Dim c As Range, rng
 Dim val1 As String
 Set rng = Range("BP22:BP1020")
 For Each c In rng
 If c.Value <> "" Then
val1 = val1 & "- " & c.Value & Chr(10)
 End If
 Next c
 Sheets("Calcolatore").Activate
 Range("R16") = val1
 
    ElseIf Not Intersect(Target, Range("Br22:Br1020")) Is Nothing Then
        Dim c As Range, rng
 Dim val1 As String
 Set rng = Range("Br22:Br1020")
 For Each c In rng
 If c.Value <> "" Then
val1 = val1 & "- " & c.Value & Chr(10)
 End If
 Next c
 Sheets("Calcolatore").Activate
 Range("ag16") = val1
 
    ElseIf Not Intersect(Target, Range("Bt22:Bt1020")) Is Nothing Then
        Dim c As Range, rng
 Dim val1 As String
 Set rng = Range("Bt22:Bt1020")
 For Each c In rng
 If c.Value <> "" Then
val1 = val1 & "- " & c.Value & Chr(10)
 End If
 Next c
 Sheets("Calcolatore").Activate
 Range("av16") = val1
    End If
 
End Sub