Excel Data Arrangement

Question

I have been trying to read lap times from a website into excel so i can post the results after the race and already have done that "successfully" however the times are not displayed using the html table function so when parsing the times to excel i got something like this: msgbox test result(msg box just for testing)

Now i must build something like a table with this text/values in a spcific order like this results_table. I know how to put them all together in a cell or present them one by one in a msgbox but not how to organize them the way i need...

The website im getting times from: "https://speedhive.mylaps.com/LiveTiming/OVXRNRVR-2147485174/Active"

"SOLUTION ON EDIT V2"

Excel vba code:

Sub Get_Race_Results()

Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim times As Variant

website = "https://speedhive.mylaps.com/LiveTiming/OVXRNRVR-2147485174/Active"
Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "GET", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send
response = StrConv(request.responseBody, vbUnicode)
html.body.innerHTML = response
times = html.getElementsByClassName("row tab-pane active scrollable").Item(0).innerText

MsgBox times
End Sub´

EDIT V1: I could do it by using this code:

Sub Get_Race_Results()
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim times As Variant
website = "https://speedhive.mylaps.com/Sessions/6333683"
Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "GET", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send
response = StrConv(request.responseBody, vbUnicode)
html.body.innerHTML = response
times = html.getElementsByClassName("tab-content").Item(0).innerText
Dim LookInHere As String
Dim Counter As Integer
Dim SplitCatcher As Variant
LookInHere = times
SplitCatcher = Split(LookInHere, vbLf)
'headers
Range("A1").Value = Split(LookInHere, vbLf)(0)
Range("B1").Value = Split(LookInHere, vbLf)(1)
Range("C1").Value = Split(LookInHere, vbLf)(2)
Range("D1").Value = Split(LookInHere, vbLf)(3)
Range("E1").Value = Split(LookInHere, vbLf)(4)
Range("F1").Value = Split(LookInHere, vbLf)(5)
Range("G1").Value = Split(LookInHere, vbLf)(6)
Range("H1").Value = Split(LookInHere, vbLf)(7)
Range("I1").Value = Split(LookInHere, vbLf)(8)
Range("J1").Value = Split(LookInHere, vbLf)(9)
'1line
Range("A2").Value = Split(LookInHere, vbLf)(10)
Range("B2").Value = Split(LookInHere, vbLf)(11)
'IGNORE C2 OR LEAVE IT BLANK
Range("D2").Value = Split(LookInHere, vbLf)(12)
Range("E2").Value = Split(LookInHere, vbLf)(13)
Range("F2").Value = Split(LookInHere, vbLf)(14)
Range("G2").Value = Split(LookInHere, vbLf)(15)
Range("H2").Value = Split(LookInHere, vbLf)(16)
Range("I2").Value = Split(LookInHere, vbLf)(17)
Range("J2").Value = Split(LookInHere, vbLf)(18)
'2line etc etc until end

 End Sub

EDIT V2:

Sub Get_Web_Data()
Dim request As Object
Dim response As String
Dim html As New HTMLDocument
Dim website As String
Dim times As Variant
website = "https://speedhive.mylaps.com/Sessions/6333683"
Set request = CreateObject("MSXML2.XMLHTTP")
request.Open "GET", website, False
request.setRequestHeader "If-Modified-Since", "Sat, 1 Jan 2000 00:00:00 GMT"
request.send
response = StrConv(request.responseBody, vbUnicode)
html.body.innerHTML = response
times = html.getElementsByClassName("tab-content").Item(0).innerText

Dim LookInHere As String
Dim Counter As Integer
Dim SplitCatcher As Variant
LookInHere = times
SplitCatcher = Split(LookInHere, vbLf)
Dim lrow As Long
Dim col As Long
Dim i As Long

For col = 2 To 12
For lrow = 1 To 9
Worksheets("Sheet1").Cells(col, lrow).Value = Split(LookInHere, vbLf)((10) + i)
i = i + 1
Next lrow
Next col

Answer 1

You need to apply the correct time formatting to the appropriate columns based on header name, after first writing out the table. The table you can reconstruct to look like a table (as not actually a table element) by looping the retrieval of all the values to write into table format and using the headers length to determine when to write out to next row.

N.B. Your mileage may vary depending on Excel version. The following is with Excel 2019 and should work for maintained versions of MSHTML.dll.

---

Option Explicit

Public Sub GetTimes()
    'tools > references > Microsoft HTML Object Library
    Dim html As MSHTML.HTMLDocument, xhr As Object
    
    Set xhr = CreateObject("MSXML2.XMLHTTP")
    Set html = New MSHTML.HTMLDocument
    
    With xhr
        .Open "GET", "https://speedhive.mylaps.com/LiveTiming/OVXRNRVR-2147485174/Active", False
        .setRequestHeader "User-Agent", "Safari/537.36"
        .send
        html.body.innerHTML = .responseText
    End With
    
    Dim headers As MSHTML.IHTMLDOMChildrenCollection, resultCells As MSHTML.IHTMLDOMChildrenCollection
    
    Set headers = html.querySelectorAll("#result-list [class^=header]")
    Set resultCells = html.querySelectorAll("#result-list .row-result [id^=result-]:not(.marker)")
    
    Dim numberOfColumns As Long, i As Long, c As Long, results() As Variant, r As Long
    
    numberOfColumns = headers.length
    ReDim results(1 To resultCells.length / numberOfColumns, 1 To numberOfColumns)
    
    c = 1: r = 0
    For i = 0 To resultCells.length - 1
        If i Mod numberOfColumns = 0 Then
            r = r + 1: c = 1
        End If
        results(r, c) = resultCells(i).innerText
        c = c + 1
    Next
    
    Application.ScreenUpdating = False
    
    With ActiveSheet
        .Cells.ClearContents
        .Cells.ClearFormats
        
        For i = 1 To numberOfColumns
            .Cells(1, i) = headers.Item(i - 1).innerText
            If IsNumeric(Application.Match(Trim$(headers.Item(i - 1).innerText), Array("Last Lap", "Best Lap"), 0)) Then
                .Columns(i).NumberFormat = "m:ss.000"
            ElseIf IsNumeric(Application.Match(Trim$(headers.Item(i - 1).innerText), Array("Total Time"), 0)) Then
                .Columns(i).NumberFormat = "h:m:ss.000"
            End If
        Next
        
        .Cells(2, 1).Resize(UBound(results, 1), numberOfColumns) = results
        
        Dim bestTime As Double, times() As Variant, bestLapColumn As Long, cell As Range
        
        bestLapColumn = Application.Match("Best Lap", .UsedRange.Rows(1).value, 0)
        
        On Error Resume Next
        times = Application.Transpose( _
                Application.Index(.UsedRange.Offset(1, 0).Resize(.UsedRange.Rows.Count - 1, .UsedRange.Columns.Count), 0, bestLapColumn))
        
        bestTime = Application.WorksheetFunction.Min(times)
        
        For Each cell In Intersect(.UsedRange, .Columns(bestLapColumn))
            If cell.value = bestTime Then cell.Font.Color = vbMagenta
        Next
        On Error GoTo 0
    End With

End Sub

---

As per the html, Competitor is currently a blank column: