Web Data Scraper

Sub ScrapeWebData()
    Dim http As Object
    Dim html As Object
    Dim url As String
    Dim response As String
    Dim tables As Object
    Dim table As Object
    Dim rows As Object
    Dim cells As Object
    Dim ws As Worksheet
    Dim r As Long, c As Long

    ' Get URL from user
    url = InputBox("Enter website URL to scrape:")
    If url = "" Then Exit Sub

    ' Create HTTP request object
    Set http = CreateObject("MSXML2.XMLHTTP")

    ' Make request
    http.Open "GET", url, False
    http.send

    ' Get response
    response = http.responseText

    ' Parse HTML
    Set html = CreateObject("HTMLFile")
    html.body.innerHTML = response

    ' Create new worksheet
    Set ws = Worksheets.Add
    ws.Name = "WebData_" & Format(Now, "mmdd_hhmm")

    ' Find and extract table data
    Set tables = html.getElementsByTagName("table")

    If tables.Length > 0 Then
        Set table = tables(0)  ' Get first table
        Set rows = table.getElementsByTagName("tr")

        r = 1
        For Each row In rows
            Set cells = row.getElementsByTagName("td")
            If cells.Length = 0 Then
                Set cells = row.getElementsByTagName("th")  ' Header cells
            End If

            c = 1
            For Each cell In cells
                ws.Cells(r, c).Value = cell.innerText
                c = c + 1
            Next cell
            r = r + 1
        Next row

        ' Format the data
        With ws.Range("A1").CurrentRegion
            .Font.Name = "Arial"
            .Font.Size = 10
            .Borders.LineStyle = xlContinuous
        End With

        ' Make header bold
        ws.Rows(1).Font.Bold = True
        ws.Columns.AutoFit

        MsgBox "Web data extracted successfully!"
    Else
        MsgBox "No tables found on the webpage."
    End If
End Sub