• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Concatenate Text and Paste

E

exc4libur

Member
Hello!

I have a problem, which can be manually managed through "Sorting, Concatenate and Transpose". However, this method can consume a lot of time, if not days!

Every "comment" I make is entered in Column B @ Sheet 2 and is given a "name" in Column A (each person has more than one comment).
Then, I sort the table in Sheet 2, concatenate all comments per name and paste them according to the name in Sheet 1.

I've attached a sample showing exactly how it should come out.

Thanks in advance for the help!
 

Attachments

  • Book1.xlsx
    18.2 KB · Views: 0
exc4libur said:
Hey Somendra,

Nice job! But, is there a way to find the name in sheet 1 and then paste the output?

Rgds
Click to expand...
Hi,

I think the code will work for unsorted names also. Have you tried code on unsorted names. As the code is checking names on sheet 1 from sheet 2 and than updating the comments.

Regards,
 
Hi !

A way from Sheet1 :​
Code: 
Sub Demo()
Dim Rs As Range, Rf As Range
Set Rs = Sheet2.Cells(1).CurrentRegion.Columns(1)
    Rs.Resize(, 2).Sort Rs.Cells(1), xlAscending, Header:=xlYes

With Sheet1.Cells(1).CurrentRegion.Columns(1).Cells
    ReDim VA$(2 To .Count, 0)

    For R& = 2 To .Count
         Set Rf = Rs.Find(.Item(R).Value, , xlValues, xlWhole)
      If Not Rf Is Nothing Then VA(R, 0) = "{""" & Join(Application.Transpose(Range(Rf, Rs.Find(Rf.Value, , , , , xlPrevious)).Offset(, 1).Value), """,""") & """}"
    Next
   
    .Offset(1, 1).Resize(.Count - 1).Value = VA
End With

Set Rs = Nothing:  Set Rf = Nothing
End Sub
Do you like it ? So thanks to click on bottom right Like !
​
 
Somendra Misra said:
Hi,

I think the code will work for unsorted names also. Have you tried code on unsorted names. As the code is checking names on sheet 1 from sheet 2 and than updating the comments.

Regards,
Click to expand...

The concatenating part works perfectly, the issue is when I have a list of names in sheet1 and no comments for that on sheet2. The code re-fills the list in sheet1 with only the name that contain comments from sheet2.

Please find attached an example.
 

Attachments

  • Book1.xlsx
    16.3 KB · Views: 0
Try this !​
Code: 
Sub Demo()
Dim Rs As Range, Rf As Range
Set Rs = Sheet2.Cells(1).CurrentRegion.Columns(1)
    Rs.Resize(, 2).Sort Rs.Cells(1), xlAscending, Header:=xlYes

With Sheet1.Cells(1).CurrentRegion.Columns(1).Cells
    ReDim VA$(2 To .Count, 0)

    For R& = 2 To .Count
         Set Rf = Rs.Find(.Item(R).Value, , xlValues, xlWhole)
      If Not Rf Is Nothing Then
         Set Rf = Range(Rf, Rs.Find(Rf.Value, , , , , xlPrevious)).Offset(, 1)
         If Application.CountA(Rf) Then VA(R, 0) = "{""" & Join(Application.Transpose(Rf.Value), """,""") & """}"
      End If
    Next
                 Set Rf = Nothing:  Set Rs = Nothing
    .Offset(1, 1).Resize(.Count - 1).Value = VA
End With
End Sub
You like ? So thanks to …
​
 
Marc L said:
Try this !​
Code: 
Sub Demo()
Dim Rs As Range, Rf As Range
Set Rs = Sheet2.Cells(1).CurrentRegion.Columns(1)
    Rs.Resize(, 2).Sort Rs.Cells(1), xlAscending, Header:=xlYes

With Sheet1.Cells(1).CurrentRegion.Columns(1).Cells
    ReDim VA$(2 To .Count, 0)

    For R& = 2 To .Count
         Set Rf = Rs.Find(.Item(R).Value, , xlValues, xlWhole)
      If Not Rf Is Nothing Then
         Set Rf = Range(Rf, Rs.Find(Rf.Value, , , , , xlPrevious)).Offset(, 1)
         If Application.CountA(Rf) Then VA(R, 0) = "{""" & Join(Application.Transpose(Rf.Value), """,""") & """}"
      End If
    Next
                 Set Rf = Nothing:  Set Rs = Nothing
    .Offset(1, 1).Resize(.Count - 1).Value = VA
End With
End Sub
You like ? So thanks to …
​
Click to expand...

Hi Marc,

First of all, thank you for helping me with this thread and the others!! You're awesome!!

When I tried the code with small quantities, the procedure runs fine, but with larger strings I keep getting run-time error '13'.

Rgds
 
exc4libur said:
The concatenating part works perfectly, the issue is when I have a list of names in sheet1 and no comments for that on sheet2. The code re-fills the list in sheet1 with only the name that contain comments from sheet2.

Please find attached an example.
Click to expand...
If there are no comments for a particular name than column B on Sheet 1 will remain blank. What do you want to do with these names?

Regards,
 
Somendra Misra said:
If there are no comments for a particular name than column B on Sheet 1 will remain blank. What do you want to do with these names?

Regards,
Click to expand...

I would like to run the names in Sheet1 and fetch the comments (concatenat'd) in Sheet2. So, if the name in Sheet1 has no comments in Sheet2, then column B would be blank.

Rgds
 

Big difference between worksheets #2 in first sample and this new one !

In original input data, no characters like { " , } and only one comment by row, pretty easy to construct final ouput comments with those characters.

Now in the last sample, input data are like output data,
so my code can't work and I don't understand such a difference !

So what could be the output when input is already an output ?

And cells are limited in characters …
​
 
Marc L said:
Big difference between worksheets #2 in first sample and this new one !

In original input data, no characters like { " , } and only one comment by row, pretty easy to construct final ouput comments with those characters.

Now in the last sample, input data are like output data,
so my code can't work and I don't understand such a difference !

So what could be the output when input is already an output ?

And cells are limited in characters …
​
Click to expand...

Sorry about that Marc. You guys are already helping so much, I didn't want to be too specific.
Anyways, the delimeter isn't really necessary, a simple "space" is suffice.
Now, the cells being limited in characters is news for me. The max. chars I have for a name is around 24KB.
 
Max in last sample workbook is 66 501 characters for Annamaria !
Maybe too heavy for a cell …​
Code: 
Sub Demo2a()
Dim Rs As Range, Rf As Range
Set Rs = Sheet2.Cells(1).CurrentRegion.Columns(1)
    Rs.Resize(, 2).Sort Rs.Cells(1), xlAscending, Header:=xlYes
    Application.ScreenUpdating = False

With Sheet1.Cells(1).CurrentRegion
    For R& = 2 To .Rows.Count
             T$ = ""
         Set Rf = Rs.Find(.Cells(R, 1).Value, , xlValues, xlWhole)
      If Not Rf Is Nothing Then
         Set Rf = Range(Rf, Rs.Find(Rf.Value, , , , , xlPrevious)).Offset(, 1)

         If Application.CountA(Rf) Then
                                     T = "{""" & Rf(1).Value
            For N& = 2 To Rf.Count:  T = T & """,""" & Rf(N).Value:  Next
                                     T = T & """}"
         End If
      End If
                         On Error Resume Next
                         .Cells(R, 2).Value = T
      If Err.Number Then .Cells(R, 2).Value = Err.Description
                         On Error GoTo 0
    Next
         Set Rf = Nothing:  Set Rs = Nothing
End With
End Sub
 
Last edited:
Amending to cut characters in excess :​
Code: 
Sub Demo2b()
Dim Rs As Range, Rf As Range
Set Rs = Sheet2.Cells(1).CurrentRegion.Columns(1)
    Rs.Resize(, 2).Sort Rs.Cells(1), xlAscending, Header:=xlYes
    Application.ScreenUpdating = False
 
With Sheet1.Cells(1).CurrentRegion
    For R& = 2 To .Rows.Count
             T$ = ""
         Set Rf = Rs.Find(.Cells(R, 1).Value, , xlValues, xlWhole)
      If Not Rf Is Nothing Then
         Set Rf = Range(Rf, Rs.Find(Rf.Value, , , , , xlPrevious)).Offset(, 1)
 
        If Application.CountA(Rf) Then
                                     T = "{""" & Rf(1).Value
            For N& = 2 To Rf.Count:  T = T & """,""" & Rf(N).Value:  Next
                                     T = T & """}"
        End If
      End If
                    .Cells(R, 2).Value = Left$(T, 65509)
    Next
             Set Rf = Nothing:  Set Rs = Nothing
End With
End Sub
 

I forgot to mention :
even if Demo2b cuts string from character #65510,
a cell stores up to 32767 characters in my Excel version, check in yours …
​
 
Marc L said:
I forgot to mention :
even if Demo2b cuts string from character #65510,
a cell stores up to 32767 characters in my Excel version, check in yours …
​
Click to expand...

Hahahah I was just researching this right now! I'm gonna run the code and get back to you asap.
 
Better braces management in this new code
and cells end with "…" in case of too long comments :​
Code: 
Sub Demo2c()
Const MAX = 32767
  Dim Rs As Range, Rf As Range
  Set Rs = Sheet2.Cells(1).CurrentRegion.Columns(1)
      Rs.Resize(, 2).Sort Rs.Cells(1), xlAscending, Header:=xlYes
      Application.ScreenUpdating = False

With Sheet1.Cells(1).CurrentRegion
    For R& = 2 To .Rows.Count
             T$ = ""
         Set Rf = Rs.Find(.Cells(R, 1).Value, , xlValues, xlWhole)
      If Not Rf Is Nothing Then
         Set Rf = Range(Rf, Rs.Find(Rf.Value, , , , , xlPrevious)).Offset(, 1)

         If Application.CountA(Rf) Then
                                      V = Rf.Value
                                      T = "{""" & Replace$(Replace$(V(1, 1), "{""", ""), """}", "")
            For N& = 2 To UBound(V):  T = T & """,""" & Replace$(Replace$(V(N, 1), "{""", ""), """}", ""):  Next
                                      T = T & """}"
                 If Len(T) > MAX Then T = Left$(T, InStrRev(T, ",", MAX) - 1) & Chr$(133)
         End If
      End If
                     .Cells(R, 2).Value = T
    Next
              Set Rf = Nothing:  Set Rs = Nothing
End With
End Sub
 
Last edited:
You must log in or register to reply here.
Back
Top