Modify VBA due to web source code change

**IdabaMalouki** · 07-01-2025, 01:56 PM

I copy and paste data from a web page. They have changed their format again! Can someone please change VBA so that data is arranged in Columns C-I in workbook below? Thanks in advance.

Option Explicit

Sub sortdata()
Dim a(), b()
Dim i As Long, k As Long, lr As Long

    lr = Range("A" & Rows.Count).End(xlUp).Row
    
    a = Range("A1:A" & lr).Value
    ReDim b(1 To UBound(a, 1), 1 To 8)
  
    For i = 1 To UBound(a, 1) Step 22
        If a(i, 1) <> "Spread" Then Exit For
        k = k + 1
        b(k, 1) = a(i + 19, 1)
        b(k, 2) = a(i + 3, 1)
        b(k, 3) = a(i + 4, 1)
        b(k, 4) = a(i + 5, 1)
        b(k, 5) = a(i + 6, 1)
        b(k, 6) = a(i + 7, 1)
        b(k, 7) = a(i + 8, 1)
        b(k, 8) = a(i + 9, 1)
        
        k = k + 1
        b(k, 2) = a(i + 10, 1)
        b(k, 3) = a(i + 11, 1)
        b(k, 4) = a(i + 12, 1)
        b(k, 5) = a(i + 13, 1)
        b(k, 6) = a(i + 14, 1)
        b(k, 7) = a(i + 15, 1)
        b(k, 8) = a(i + 16, 1)
    Next
    Range("C2").Resize(k, UBound(b, 2)).Value = b
    Range("C2").Resize(k).NumberFormat = "h:mm AM/PM"
End Sub

AnotherMacrosFIX.xlsm

**JohnTopley** · 07-01-2025, 02:11 PM

Try

Option Explicit

Sub demox()
Dim a, b
Dim i As Long, j As Long, n As Long, nx As Long, lr As Long

lr = Cells(Rows.Count, "A").End(xlUp).Row
a = [A1].Resize(lr, 1)
nx = Application.CountIf(Columns(1), "Spread")
ReDim b(1 To nx * 2, 1 To 8)


For i = 1 To UBound(a, 1) Step 23
    If a(i, 1) = "Spread" Then
        n = n + 1
        b(n, 2) = a(i + 3, 1):
        For j = 3 To 7
            b(n, j) = a(i + j + 2, 1)
        Next j
        b(n, 1) = a(i + 19, 1)
        n = n + 1
        b(n, 2) = a(i + 10, 1):
        For j = 3 To 7
            b(n, j) = a(i + j + 9, 1)
        Next j
    End If
Next i

[C2].Resize(n, 8) = b
Columns(3).NumberFormat = "h:mm AM/PM"
End Sub