Transpose Range and Copy text to Clipboard with comma seperated.

[jonnathanjons]

Hello,

I use bellow code to transpose the column range to a single cell horizontally separated with comma. Pls note its not transposing horizontally in different cells but in a single cell seperated with comma. I wanted to expand this script to perform in the cell where selection.offset(2,2) . currently the result is appearing only in Cells(2,2) but I would like to show the results in the Selection.offset(2,2) of the column where I select the range.
Please see my original script and the one I am trying to achieve. it only transposing 1st 2 rows and is stopped

2nd part is the usage of sendkeys to copy the text and paste it to another datamining application. Simple copy and paste does not work.so need the text copy.Is there a better way to copy the text from a cell than the way mentioned below?
Pls see attached xlxs sheet for example .sheet Requirement is what I wanted to change the script to?

Original code working fine

Code: Select all

Sub copyrangeforapp()
Cells(2, 2).NumberFormat = "@"
Cells(2, 2) = ""
xRow = 1

Do While Cells(xRow, 1) <> ""
    If Cells(2, 2) = "" Then
    Cells(2, 2) = Cells(xRow, 1)
    Else
    Cells(2, 2) = Cells(2, 2) & "," & Cells(xRow, 1)
    End If
xRow = xRow + 1
Loop
Cells(2, 2) = Cells(2, 2)

Range("B2").Select
 Application.CutCopyMode = False
    Application.SendKeys "{F2}"
    Application.SendKeys "^a"
    Application.SendKeys "^c"
    'Application.SendKeys "~"
    Application.SendKeys "{Esc}"
End Sub

New Requirement to transpose to column after user selected column

Code: Select all

Sub Copyrange4app()

Selection.Offset.Cells(2, 2).NumberFormat = "@"
Selection.Offset.Cells(2, 2) = ""
xRow = 1

Do While Selection.Cells(xRow, 1) <> ""
    If Selection.Offset.Cells(2, 2) = "" Then
    Selection.Offset.Cells(2, 2) = Selection.Cells(xRow, 1)
    Else
    Selection.Offset.Cells(2, 2) = Selection.Cells(xRow, 1) & "," & Selection.Cells(xRow, 1)
    End If
xRow = xRow + 1
Loop
Selection.Offset.Cells(2, 2) = Selection.Offset.Cells(2, 2)

Range("B2").Select
 Application.CutCopyMode = False
    Application.SendKeys "{F2}"
    Application.SendKeys "^a"
    Application.SendKeys "^c"
    'Application.SendKeys "~"
    Application.SendKeys "{Esc}"
End Sub

[snb]

Code: Select all

Sub M_snb()
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .SetText Join(Evaluate("transpose(" & Selection.Address & ")"), ", ")
    .PutInClipboard
  End With
End Sub

[HansV]

For Excel in Office 2016 and earlier:

Code: Select all

Sub Copyrange4app()
    Dim cel As Range
    Dim s As String
    For Each cel In Selection
        If cel.Value <> "" Then
            s = s & "," & cel.Value
        End If
    Next cel
    If s <> "" Then
        s = Mid(s, 2)
    End If
    With Selection(1).Offset(1, 1)
        .NumberFormat = "@"
        .Value = s
    End With
End Sub

For Microsoft 365 and Office 2021:

Code: Select all

Sub Copyrange4app()
    With Selection(1).Offset(1, 1)
        .NumberFormat = "@"
        .Value = Application.TextJoin(",", True, Selection)
    End With
End Sub

[DocAElstein]

Hi

Here is another Clipboard way. I expect snb’s would be a bit quicker. Here is the two together for if you want to compare performance

Code: Select all

 Option Explicit
Sub M_snb() '  https://www.eileenslounge.com/viewtopic.php?p=308270#p308270
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
     .settext Join(Evaluate("transpose(" & Selection.Address & ")"), ", ")
     .PutInClipboard
    End With
 Let Selection(1).Offset(1, 1).NumberFormat = "@"
 ActiveSheet.Paste Destination:=Selection(1).Offset(1, 1)
End Sub
Sub ClipItb() ' https://www.eileenslounge.com/viewtopic.php?f=27&t=39784
 Selection.Copy
    With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    Dim StringBack As String
     .GetFromClipboard: Let StringBack = .GetText()
     Let StringBack = Replace(Left(StringBack, Len(StringBack) - 2), vbCr & vbLf, ", ")
     .Clear
     .settext StringBack
     .PutInClipboard
    End With
 Let Selection(1).Offset(1, 1).NumberFormat = "@"
 ActiveSheet.Paste Destination:=Selection(1).Offset(1, 1)
End Sub

Mine is basically replacing
_ what Excel ( and most things) uses in the clipboard for a line/ row, which is a vbCr & vbLf
_ with a comma ( and space, just to compare with snb’s )

So then Excel thinks it just has a single cell of text in the clipboard, since there is no longer anything in the clipboard to tell it has multiple cell values

(More notes about it later here )


Alan

[jonnathanjons]

Hi, Apologies for not getting back earlier as i was (still) busy with month/Qtr end activities. I also apologize for editing this response 3 times already...

@SNB : Thank you for your response. Please ignore my previous notes if you have seen them . I removed them because its working fine now . your script is pasting to the clipboard. But I was expecting the result will be shown in the cells C2 which I did not notice in the beginning. but This is great I can use them for scenarios where I do not need to see the result in C2 but only paste to application is only needed. thanks again.

@DocAELstein First part of your script Sub M_snb () is working fine as expected and is also copying to clipboard. I was getting some error earlier as I had the same Sub name in the vba same page as snb's first one.so I ran with sub with M_snb1() and it worked fine.
Your 2nd script ( Sub ClipIt() ) is working too . but is a bit longer than your first one..thanks for the same.

@HansV : As always , works wonderfully, short and quick . I use microsoft 365. But I am trying to see how I can add Copy to clipboard part is missing so that I can paste it in my applications field to run queries with this data.

Basically My requirement is to text join the range for each value with " , " so that I can add it to my sql statements to pull queries from db2. Some times this range will run into 5000 to 8000 rows to text join and copy to clipboard. So I prefer a script which run faster and can reduce cpu time.
Thanks again for all your contribution.

I may have an additional request (only) if your time permits. If there is any way to remove the duplicates from the Selectin range and then text join with ", " and Copy to Clipboard. In that way there may be many rows removed. Sorry for not mentioning this earlier.

[robertocm]

Is there a better way to copy the text from a cell than the way mentioned below?

I use code from LockeGarmin (Feb 18, 2016):
https://stackoverflow.com/questions/354 ... 3#35486033

As he explains, creating a module called 'mClipboard' and the use as 'mClipboard.SetText' / 'mClipboard.GetText'

(tested on 32-bit and 64 versions of Excel)

[jonnathanjons]

Is there a better way to copy the text from a cell than the way mentioned below?

I use code from LockeGarmin (Feb 18, 2016):
https://stackoverflow.com/questions/354 ... 3#35486033

As he explains, creating a module called 'mClipboard' and the use as 'mClipboard.SetText' / 'mClipboard.GetText'

(tested on 32-bit and 64 versions of Excel)

Thank You for your response and sharing the link.

[jonnathanjons]

Hello in the above script provided I added to remove duplicates in the selected range but I am getting results as
AAA00296, AAA00298, AAA00271, AAA00313, AAA00345, AAA00370, AAA00372, , , , , , , , , , , , , , , , . Is there a way to remove the comma after the last value?

Code: Select all

Sub Copyrange4app()
Application.ScreenUpdating = False
With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
     If WorksheetFunction.TRIM(ActiveCell) = "" Or Selection.Count = 1 Then
      Msgbox "Slect the range to copy.", vbOKOnly, "Warning"
      Exit Sub
  Else
     Selection.Columns.RemoveDuplicates Columns:=1, Header:=xlNo
     .SetText Join(Evaluate("transpose(" & Selection.Address & ")"), ", ")
     .PutInClipboard
  End If
    End With
 Let Selection(1).Offset(1, 1).NumberFormat = "@"
 ActiveSheet.Paste Destination:=Selection(1).Offset(1, 1)
 Application.ScreenUpdating = True
End Sub

[HansV]

Please take a moment to learn how to use [code] ... [/code] tags:

Outputting code or fixed width data

[jonnathanjons]

Thanks for reminding. Even though the link is overwhelming I learned it thru a youtube video on how to use it.I will keep in mind next time I update a code.

[DocAElstein]

Hi
Code tags is probably one of the most used tag things in a lot of forums having anything to do with coding. Usually there is a button for it. Here it’s in the Full editor window and looks like this </>
( I personally have a lot of simple short macros in Word running off short cut keys that add all the forum editor tags I use. So I prepare all my post in Word then finally copy it all across into a forum editor in one go. I find that useful when posting a lot, and then you also have a good back up of all your posts, ( although my organising of them all could do with a lot of improvement, Lol. – I find it useful having my own forum just to try and keep order of some of my stuff, Lol) )
_.___________


A convenient way to get rid of those extra trailing comers would be to change the comers to a space then do a VBA Trim which would remove all trailing spaces, but leave the other ones in, then change the spaces back to a comer and space combination


Like this

Code: Select all

Sub TrailAwayOnASunnyDay() '  https://eileenslounge.com/viewtopic.php?p=308473#p308473
Dim Str As String: Let Str = "AAA00296, AAA00298, AAA00271, AAA00313, AAA00345, AAA00370, AAA00372, , , , , , , , , , , , , , , , "
 Let Str = Replace(Str, ",", " ", 1, -1, vbBinaryCompare)
 Let Str = Trim(Str)
 Let Str = Replace(Str, "  ", ", ", 1, -1, vbBinaryCompare)
Debug.Print Str ' From within VB Editor  hit keys   Ctrl+g  to see it

' Or combine it all so it looks more clever
 Let Str = "AAA00296, AAA00298, AAA00271, AAA00313, AAA00345, AAA00370, AAA00372, , , , , , , , , , , , , , , , "
 Let Str = Replace(Trim(Replace(Str, ",", " ", 1, -1, vbBinaryCompare)), "  ", ", ", 1, -1, vbBinaryCompare)
Debug.Print Str

' remove any arguments that you don't need, - in this case    , 1, -1, vbBinaryCompare    are the default values taken when you don't give them
 Let Str = "AAA00296, AAA00298, AAA00271, AAA00313, AAA00345, AAA00370, AAA00372, , , , , , , , , , , , , , , , "
 Let Str = Replace(Trim(Replace(Str, ",", " ")), "  ", ", ")

End Sub

You should be able to figure out how to apply that idea to what you are doing- For example, to apply that to the bit of snbs coding that you are using in your last coding , you would replace this

Code: Select all

Join(Evaluate("transpose(" & Selection.Address & ")"), ", ")

With

Code: Select all

Replace(Trim(Replace(Join(Evaluate("transpose(" & Selection.Address & ")"), ", "), ",", " ")), "  ", ", ")

, since in my demo macro, Sub TrailAwayOnASunnyDay() , my
Str
is what you are getting from snbs
Join(Evaluate("transpose(" & Selection.Address & ")"), ", ")



Alan

[jonnathanjons]

I tried above but the comma was depending on the duplicates I have in the range ..sometimes 5 sometimes 7 ,2 etc. so I was still getting the comma for the same amount of duplicates I have. However I tried my best to achieve it in an old fashioned way by adding "Range(Selection.Rows(1), Selection.End(xlDown)).Select" Please see my code. I am hoping I am pasting the code in the right way. ITs works for me now..thanks every one for your input. without your input I wouldn't have achieved this.. I love this team...

Code: Select all

Sub Copyrange4apps()
Application.ScreenUpdating = False
If WorksheetFunction.TRIM(ActiveCell) = "" Then
      Msgbox "Slect the range to copy.", vbOKOnly, "Warning": Exit Sub
  Else
   With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
      Selection.Columns.RemoveDuplicates Columns:=1, Header:=xlNo
      Range(Selection.Rows(1), Selection.End(xlDown)).Select                       '<<<<<<<< Look here for my input
     .SetText Join(Evaluate("transpose(" & Selection.Address & ")"), ", ")
     .PutInClipboard
    End With
 End If
 Let Selection(1).Offset(1, 1).NumberFormat = "@"
 ActiveSheet.Paste Destination:=Selection(1).Offset(1, 1)
 Application.ScreenUpdating = True
End Sub

[HansV]

Congratulations, you used the code tags correctly!

[DocAElstein]

I tried above but the comma was depending on the duplicates I have in the range ..sometimes 5 sometimes 7 ,2 etc. so I was still getting the comma for the same amount of duplicates I have.

I have no idea what you are saying there. Never mind, glad you got there, :)