Code To Move From Vertical To Horizontal?

Option Explicit
Option Compare Text

Public Function GROUPON(group_key As Variant, table_array As Range, col_index_num As Long, Optional delim As String = " ")

    Application.Volatile

    Dim s               As String
    Dim cell            As Range
    Dim rangeToCheck    As Range
    
    With table_array
        Set rangeToCheck = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1))
    End With
    
    For Each cell In rangeToCheck
        If cell.Value = group_key Then s = s & cell.Offset(0, col_index_num - 1).Value & delim
    Next cell
    
    If Len(s) > 0 Then s = Left(s, Len(s) - Len(delim))
    GROUPON = s

End Function

Public Sub DescribeFunction_GROUPON()
    Dim FuncName As String
    Dim FuncDesc As String
    Dim Category As String
    Dim ArgDesc(1 To 5) As String
    
    FuncName = "GROUPON"
    FuncDesc = "Concatenates values from a table based on a provided key in the first column"
    Category = 7 'Text category
    ArgDesc(1) = "is a unique key upon which to group values"
    ArgDesc(2) = "is the Range in which the values are to be found where group_key will be found in the first column"
    ArgDesc(3) = "is the column number in table_array which contains the values to return (where the first column is 1)"
    ArgDesc(4) = "is the symbol to use as a delimiter between the values, where the default is a single space"
       
    Application.MacroOptions _
        Macro:=FuncName, _
        Description:=FuncDesc, _
        Category:=Category, _
        ArgumentDescriptions:=ArgDesc
        
End Sub

=GROUPON(group_key, table_array, col_index_num, [delim])

group_key is a unique key upon which to group values
table_array is the Range in which the values are to be found where group_key will be found in the first column
col_index_num is the column number in table_array which contains the values to return (where the first column is 1)
[delim] is an optional argument for symbol to use as a delimiter between the values, where the default is a single space

[COLOR="Navy"]Sub[/COLOR] MG14Nov22
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Set[/COLOR] Rng = Range(Range("A8"), Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not .Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        .Add Dn.Value, Dn.Offset(1).Value
    [COLOR="Navy"]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & "/ " & Dn.Offset(, 1).Value
    [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
Sheets("sheet2").Range("A2").Resize(.Count, 2) = Application.Transpose(Array(.Keys, .items))
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]