Transpose and Concatenate Personnel numbers in VBA

[InterserveMan16]

I have a requirement that involves a list of Personnel numbers copied into a spreadsheet that need to be transposed. They must be separated by a comma and concatenated into one cell so that they can be copied and pasted into a cell in a database. Unfortunately, this list could be just a handful of Personnel numbers, or hundreds. Though this can be achieved with “Transpose” and “Concatenate”, the users are limited in their use of Excel.</SPAN>
</SPAN>
I have searched the board threads for help and am aware of the concatenate limit in VBA, and though I can stitch code together in a clunky fashion I would really appreciate some helpful direction, particularly with the syntax.</SPAN>
</SPAN>
This is what I am trying to achieve:
</SPAN></SPAN>
Personnel number

P0000123 P0000123, P0000124, P0000125, P0000126, P0000127</SPAN></SPAN>
P0000124</SPAN></SPAN>
P0000125</SPAN></SPAN>
P0000126</SPAN></SPAN>
P0000127</SPAN></SPAN>
</SPAN></SPAN>

 

[Muhammad_Usman]

Try this in B1

=CONCATENATE(A1,",",A2,",",A3,",",A4)
you can add your number

 

[InterserveMan16]

Hi Muhammad,

Thanks for your speedy reply. Your solution is great for a handful of Personnel numbers, however when a department is involved this can be many hundreds of Personnel numbers which would be tiresome and possibly prone to error.

 

[Craggs82]

so I threw this together.

Option Explicit

Sub ConcatPersonnel()

    Dim i As Integer
    Dim n As Integer
    Dim lastRow As Integer
    Dim strValues As String
    
    'assuming data is listed in column A, will return concatenated in Row 1 of columns B onward.
    'Breaks down based on character limit of cells in excel.
    
    n = 2 'concats to "B1" cells(1,2)
    
    With ThisWorkbook.Sheets("Sheet1") 'Use correct sheet
    
        lastRow = .Range("A5000").End(xlUp).Row 'assuming less than 5000 records.
        
        For i = 1 To lastRow
             
            strValues = strValues & .Cells(i, 1).Value & ","
            
            If Len(strValues) > 32767 Then 'cell character limit
            
                strValues = Left(strValues, InStrRev(strValues, ",", Len(strValues) - 1) - 1) 'removes last entry and comma
                
                i = i - 1 'need to redo that entry. back we go.
                
                .Cells(1, n).Value = strValues
                
                strValues = "" 'resets for count
                
                n = n + 1 'column number to paste to
                
            End If
            
        Next i
        
        strValues = Left(strValues, Len(strValues) - 1) 'chops final comma
        .Cells(1, n).Value = strValues
        
    End With
    
End Sub

it breaks down into multiple cells if the string breaches the cell character limit.

hopefully helpful! if nothing else its a good starting point.

 

[Ombir]

Try this UDF:

Function Merge(rng As Range) As String
    Dim ar As Variant
    ar = Application.Transpose(rng)
    Merge = Join(ar, ", ")
End Function

 

[Craggs82]

Try this UDF:

Function Merge(rng As Range) As String
    Dim ar As Variant
    ar = Application.Transpose(rng)
    Merge = Join(ar, ", ")
End Function

That's a tidy function. I need more array work.

 

[InterserveMan16]

That works a treat, thanks so much for your help.

 

[InterserveMan16]

That truly is awesome, so little code but really does the job well. Appreciate your help