How to convert excel table values into string of value separated by commas & single quote using VBA Macro?

Viewed 421

I have an excel table that has 3 columns I am selecting those 3 columns with a certain number of rows, I want to copy those values into a string that is separated by comma & the values are encapsulated by single quotes. But I see the transpose has a limitation of only one column. Here's what I am trying so far.

Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select

Dim str as string
str = Join(Application.Transpose(Selection.Value),"','")
msgbox(str)

But as I said transpose works on only one column. Any ideas would help.

Table

   A       B       C
1    99999   88888   77777
2    55555   66666   44444
3    22222   11111   33333

Expected output

'99999','88888','77777','55555'.....'33333'

Order of items can be anything I just want to convert the values into the specified output.

1 Answers

QuotJoin UDF

Usage

In Excel:

=QuotJoin(A2:C4)

In VBA:

Sub QuotJoinTEST()
    Dim trg As Range: Set trg = Range("A1").CurrentRegion
    Dim srg As Range: Set srg = trg.Resize(trg.Rows.Count - 1).Offset(1)
    Dim Result As String: Result = QuotJoin(srg)
    Debug.Print Result
End Sub

The Function

Function QuotJoin( _
    ByVal srg As Range, _
    Optional ByVal Delimiter As String = ",", _
    Optional ByVal ByColumns As Boolean = False) _
As String
    
    If srg Is Nothing Then Exit Function
    
    Dim rCount As Long: rCount = srg.Rows.Count
    Dim cCount As Long: cCount = srg.Columns.Count
    
    Dim sData As Variant
    
    If rCount = 1 And cCount = 1 Then
        ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
    Else
        sData = srg.Value
    End If
    
    Dim rData() As String: ReDim rData(1 To rCount * cCount)
    
    Dim r As Long, c As Long, n As Long
    
    If ByColumns Then
        For c = 1 To cCount
            For r = 1 To rCount
                n = n + 1
                rData(n) = "'" & sData(r, c) & "'"
            Next r
        Next c
    Else
        For r = 1 To rCount
            For c = 1 To cCount
                n = n + 1
                rData(n) = "'" & sData(r, c) & "'"
            Next c
        Next r
    End If
    
    QuotJoin = Join(rData, Delimiter)

End Function
Related