Moving Data From Columns To Rows

[mlmrob]

Good Afternoon guys,

Each day I download a list of racehorses with the distances they have been beaten in each of their last 10 races or less.

The data downloads as all in Column A horse name and column b as didtance beaten

Horse A 6
Horse A 10
Horse A
Horse A 5
Horse B 3
Horse B 5
Horse B 1
Horse B 10
Horse C 0.5
Horse C
Horse C 6
Horse C 2

Where there is a gap it means the horse won or didn't finish the race.

What I want to do is display the data all in the same row across the columns

Horse A 6, 10, , 5
Horse B 3, 5, 1, 10

and so on

I have attached a ink from One Drive from one drive for a visual.

Dist BT.xlsx

1drv.ms

 

[kvsrinivasamurthy]

Try. Select suitable.
Formula1

=LET(a,UNIQUE(A2:A13),b,TEXTSPLIT(TEXTJOIN(",",TRUE,BYROW(a,LAMBDA(ro,TEXTJOIN(";",TRUE,IF((A2:A13=ro)*(B2:B13<>""),B2:B13,""))))),";",",",TRUE),HSTACK(a,IFERROR(b,"")))

Or Formula2

=LET(a,UNIQUE(A2:A13),b,BYROW(a,LAMBDA(ro,TEXTJOIN(",",TRUE,IF((A2:A13=ro)*(B2:B13<>""),B2:B13,"")))),HSTACK(a,b))

 

[Fluff]

Another option

=LET(u,UNIQUE(FILTER(A1:A200,A1:A200<>"")),m,MAX(COUNTIFS(A:A,u)),DROP(REDUCE("",u,LAMBDA(x,y,VSTACK(x,HSTACK(y,EXPAND(TOROW(FILTER(B1:B200,A1:A200=y)),,m,""))))),1))

 

[mumps]

VBA option:

Sub TransposeData()
    Application.ScreenUpdating = False
    Dim r As Long, c As Long, v As Variant, arr() As Variant, dic As Object, x As Long, lRow As Long, cnt As Long, y As Long: y = 1
    lRow = Range("A" & Rows.Count).End(xlUp).Row
    v = Range("A1:A" & lRow).Resize(, 2).Value
    Set dic = CreateObject("Scripting.Dictionary")
    For i = LBound(v) To UBound(v)
        If Not dic.exists(v(i, 1)) Then
            dic.Add v(i, 1), Nothing
        End If
    Next i
    cnt = dic.Count
    For i = LBound(v) To UBound(v)
        If i = lRow Then
            x = x + 1
            ReDim Preserve arr(1 To x)
            arr(x) = v(i, 2)
            Range("G" & y).Resize(, x).Value = arr
        Else
            If v(i, 1) = v(i + 1, 1) Then
                x = x + 1
                ReDim Preserve arr(1 To x)
                arr(x) = v(i, 2)
            Else
                x = x + 1
                ReDim Preserve arr(1 To x)
                arr(x) = v(i, 2)
                Range("G" & y).Resize(, x).Value = arr
                x = 0
                y = y + 1
            End If
        End If
    Next i
    Range("F1").Resize(cnt) = Application.Transpose(dic.keys)
    Application.ScreenUpdating = True
End Sub

 

[mlmrob]

Wow, such prompt replies. Thank you guys. Will try those out.

 

[mlmrob]

They all work perfectly, thank you for your help.

 

[Fluff]

Glad we could help & thanks for the feedback.