CommaDelimit by Join(Application.Transpose visible range

[GAdamWTW]

I currently comma delimit using this and put it to the clipboard using MSForms.DataObject
Dim ConvertComma
ConvertComma = Join(Application.Transpose(Selection.Value), ", ")


Dim clipboard As MSForms.DataObject
Set clipboard = New MSForms.DataObject
clipboard.SetText ConvertComma
clipboard.PutInClipboard

The issue is that this includes hidden cells. When I attempt to fix this by adding SpecialCells(xlCellTypeVisible) in the Selection.value this creates multiple selections and I get an error.
I'm needing to either store the multiple ranges as 1 range without pasting it in the work sheet or to adjust the code to accept multiple selections.

I've attempted this which has allowed me to make multiple selections however it's pasting over existing data and only storing 1 of the selections.
Dim ConvertComma
Dim myarray As Variant
myarray = Selection
Selection.Value = myarray

ConvertComma = Join(Application.Transpose(myarray), ", ")

MSForms requires turning on features in the Library so if this isn't done that section can be replaced with a msg box for troubleshooting.

 

[JoeMo]

Thank you JoeMo for all your help. It's working. In troubleshooting the piece I failed to put back the IF condition for only 1 row in the visible range.
Your changes work a minor tweak.

Here's the finished code: (Thank you again!)

Sub zCommaD_VisOnly()Dim R As Range, Ar As Range, ConvertComma
On Error Resume Next
Set R = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
Dim i As Integer
Dim clipboard As MSForms.DataObject




If Not R Is Nothing Then
    If R.Areas.Count > 1 Then
        ReDim ConvertComma(1 To R.Areas.Count)
        For i = 1 To R.Areas.Count
            If R.Areas(i).Count = 1 Then
                ConvertComma(i) = R.Areas(i).Value
            Else
                ConvertComma(i) = Join(Application.Transpose(R.Areas(i).Value), ", ")
            End If
        Next i
        ConvertComma = Join(ConvertComma, ", ")
        
    Set clipboard = New MSForms.DataObject
    clipboard.SetText ConvertComma
    clipboard.PutInClipboard
    
    Else
        ConvertComma = Join(Application.Transpose(R.Value), ", ")
        
    Set clipboard = New MSForms.DataObject
    clipboard.SetText ConvertComma
    clipboard.PutInClipboard
    
        End If
End If
End Sub

You are welcome - thanks for the reply.

 

[Rick Rothstein]

Thank you JoeMo for all your help. It's working. In troubleshooting the piece I failed to put back the IF condition for only 1 row in the visible range.
Your changes work a minor tweak.

Here's the finished code: (Thank you again!)

Sub zCommaD_VisOnly()Dim R As Range, Ar As Range, ConvertComma
On Error Resume Next
Set R = Selection.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
Dim i As Integer
Dim clipboard As MSForms.DataObject

If Not R Is Nothing Then
    If R.Areas.Count > 1 Then
        ReDim ConvertComma(1 To R.Areas.Count)
        For i = 1 To R.Areas.Count
            If R.Areas(i).Count = 1 Then
                ConvertComma(i) = R.Areas(i).Value
            Else
                ConvertComma(i) = Join(Application.Transpose(R.Areas(i).Value), ", ")
            End If
        Next i
        ConvertComma = Join(ConvertComma, ", ")
        
    Set clipboard = New MSForms.DataObject
    clipboard.SetText ConvertComma
    clipboard.PutInClipboard
    
    Else
        ConvertComma = Join(Application.Transpose(R.Value), ", ")
        
    Set clipboard = New MSForms.DataObject
    clipboard.SetText ConvertComma
    clipboard.PutInClipboard
    
        End If
End If
End Sub

If that code does what you want, then I believe the following code will also do it...

[table="width: 500"]
[tr]
	[td]Sub CommaDelimitVerticalRangeToClipboard()
  Dim Clipboard As New MSForms.DataObject
  If Selection.Count = 1 Then
    Clipboard.SetText Selection.Value
  Else
    Clipboard.SetText Replace(Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",IF(SUBTOTAL(103,OFFSET(" & Selection(1).Address & ",ROW(@)-" & Selection(1).Row & ",0)),SUBSTITUTE(@,"" "",CHAR(1)),""""))", "@", Selection.Address))))), " ", ", "), Chr(1), " ")
  End If
  Clipboard.PutInClipboard
End Sub
[/td]
[/tr]
[/table]

 

[GAdamWTW]

If that code does what you want, then I believe the following code will also do it...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub CommaDelimitVerticalRangeToClipboard()
  Dim Clipboard As New MSForms.DataObject
  If Selection.Count = 1 Then
    Clipboard.SetText Selection.Value
  Else
    Clipboard.SetText Replace(Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",IF(SUBTOTAL(103,OFFSET(" & Selection(1).Address & ",ROW(@)-" & Selection(1).Row & ",0)),SUBSTITUTE(@,"" "",CHAR(1)),""""))", "@", Selection.Address))))), " ", ", "), Chr(1), " ")
  End If
  Clipboard.PutInClipboard
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

Hi Rick,
It does not. The else argument in yours errors on multiple selections caused by the filtered range. The transpose will fail anytime there's only 1 cell or a brake in the range. This option fixes the 1 cell situation only when there is only 1 cell but then I don't need to put it into the clip board as I'll just copy/paste. The loop version allows for checking all selections whether from filters or selections in multiple columns which is more functionality than I was hoping for.
Thank you for trying to simplify the code though.

 

[Rick Rothstein]

Hi Rick,
It does not. The else argument in yours errors on multiple selections caused by the filtered range. The transpose will fail anytime there's only 1 cell or a brake in the range. This option fixes the 1 cell situation only when there is only 1 cell but then I don't need to put it into the clip board as I'll just copy/paste. The loop version allows for checking all selections whether from filters or selections in multiple columns which is more functionality than I was hoping for.
Thank you for trying to simplify the code though.

Multiple selections? You mean you have filtered your data and the made non-contiguous selections on it? Sorry, I was not anticipating that... I figured if you filtered your data, then you would make a "contiguous" selection on it. Here is my code modified to handle non-contiguous selections...

[table="width: 500"]
[tr]
	[td]Sub CommaDelimitVerticalRangeToClipboard()
  Dim Ar As Range, Txt As String, Clipboard As New MSForms.DataObject
  For Each Ar In Selection.Areas
    If Selection.Count = 1 Then
      Txt = Txt & ", " & Ar.Value
    Else
      Txt = Txt & ", " & Replace(Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(@="""","""",IF(SUBTOTAL(103,OFFSET(" & Ar(1).Address & ",ROW(@)-" & Ar(1).Row & ",0)),SUBSTITUTE(@,"" "",CHAR(1)),""""))", "@", Ar.Address))))), " ", ", "), Chr(1), " ")
    End If
  Next
  Clipboard.SetText Mid(Txt, 3)
  Clipboard.PutInClipboard
End Sub[/td]
[/tr]
[/table]

 

[GAdamWTW]

With my level of understanding of VBA I understand JoeMo's code better but I do appreciate seeing multiple working solutions. The nesting of arguments or conditions into 1 line of code is still hard for me to grasp. I think it's why I still struggle with index matching multiple conditions.
Thank you again.

 

[Rick Rothstein]

With my level of understanding of VBA I understand JoeMo's code better but I do appreciate seeing multiple working solutions. The nesting of arguments or conditions into 1 line of code is still hard for me to grasp. I think it's why I still struggle with index matching multiple conditions.

Understood, but for my own satisfaction, the code I posted did in fact work, correct?

 

[GAdamWTW]

Yes

Understood, but for my own satisfaction, the code I posted did in fact work, correct?