Transposing text from a website

[bmx37]

Hello Everyone,
I'm struggling to find a solution for a quite common issue I guess.
I am about to copy a lot of text from different websites on a daily basis.
Currently it looks like this (I.ex.: Bitcoin Price Chart (BTC) | Coinbase)

Market cap
$143.7B
Volume (24 hours)
$28.0B
Circulating supply
18.2M BTC
All-time high
$20,089

But ideally would be to have it transposed while pasting into excel.

Market cap $143.7B Volume (24 hours) $28.0B Circulating supply 18.2M BTC All-time high $20,089

Any idea what would be the most convenient way to avoid the hustle ? Macro ? Shortcut ? Addin ?

Many thanks in advance
Bart

 

[John_w]

Welcome to MrExcel forums.

You could use IE automation to copy and paste the whole web page into a temporary Excel sheet, and from there find and copy the required data to your data sheet . Try this macro:

Option Explicit

Public Sub IE_Extract_Data()

    Dim IE As Object 'InternetExplorer
    Dim URL As String
    Dim dataSheet As Worksheet
    Dim tempSheet As Worksheet
    Dim cellValues As Variant
    Dim nextRow As Long, r As Long
    Dim valuesString As String, cellValue As String
   
    With ThisWorkbook
        Set dataSheet = .Worksheets("Sheet1")
        Set tempSheet = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
    End With
   
    With dataSheet
        nextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    End With
   
    URL = "https://www.coinbase.com/price/bitcoin"
   
    Set IE = Get_IE_Window2(URL)
    If IE Is Nothing Then
        Set IE = Get_IE_Window2("")
        If IE Is Nothing Then Set IE = CreateObject("InternetExplorer.Application")
    End If
   
    With IE
        .Visible = True
        .navigate URL
        While .Busy Or .ReadyState <> 4: DoEvents: Wend
       
        .ExecWB 17, 0 'OLECMDID_SELECTALL, OLECMDEXECOPT_DODEFAULT
        .ExecWB 12, 2 'OLECMDID_COPY, OLECMDEXECOPT_DONTPROMPTUSER
        .ExecWB 18, 0 'OLECMDID_CLEARSELECTION, OLECMDEXECOPT_DODEFAULT
    End With
   
    With tempSheet
        .Activate
        .Range("A1").Select
        .Paste
        cellValues = .UsedRange.Value
        Application.DisplayAlerts = False
        .Delete
        Application.DisplayAlerts = True
    End With
   
    valuesString = ""
    For r = 1 To UBound(cellValues, 1)
        cellValue = Trim(cellValues(r, 1))
        cellValue = Replace(cellValue, Chr(160), "")
        Select Case cellValue
            Case "Market cap", "Volume (24 hours)", "Circulating supply", "All-time high"
                valuesString = valuesString & cellValue & " " & cellValues(r + 2, 1) & " "
        End Select
    Next
      
    dataSheet.Cells(nextRow, "A").Value = valuesString
   
End Sub


Private Function Get_IE_Window2(URLorName As String) As Object

    'Look for an IE browser window or tab already open at the (partial) URL or location name and, if found, return
    'that browser as an InternetExplorer object.  Otherwise return Nothing

    Dim Shell As Object
    Dim IE As Object 'InternetExplorer
    Dim i As Variant 'Must be a Variant to index Shell.Windows.Item() array
   
    Set Shell = CreateObject("Shell.Application")
   
    i = 0
    Set Get_IE_Window2 = Nothing
    While i < Shell.Windows.Count And Get_IE_Window2 Is Nothing
        Set IE = Shell.Windows.Item(i)
        If Not IE Is Nothing Then
            'Debug.Print IE.LocationURL, IE.LocationName, IE.Name
            If IE.Name = "Internet Explorer" And InStr(IE.LocationURL, "file://") <> 1 Then
                If InStr(1, IE.LocationURL, URLorName, vbTextCompare) > 0 Or InStr(1, IE.LocationName, URLorName, vbTextCompare) > 0 Then
                    Set Get_IE_Window2 = IE
                End If
            End If
        End If
        i = i + 1
    Wend
   
End Function

 

[bmx37]

Thank you for reply John.
However I think about something less complex like this one below for example:

Sub Paste_ValuesOnly_Transpose()
Selection.PasteSpecial Paste:=xlValues, Transpose:=True
Application.CutCopyMode = False
End Sub

But somehow It does not work due to the following error:

Run-time error:'1004':
PasteSpecial method of Range class failed

 

[John_w]

If you're manually copying and pasting the whole web page to Sheet3 (which puts the required text and values in A25:A39), then:

Public Sub Manual_Copy_and_Transpose()
    With Worksheets("Sheet3")
        .Activate
        .Range("A25:A39").Select
    End With
    Selection.Copy
    With Worksheets("Sheet1")
        .Activate
        .Cells(.Rows.Count, "A").End(xlUp).Offset(1).Select
    End With
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    Application.CutCopyMode = False
End Sub

 

[John_w]

Or if you're only copying the text from Market Cap to the All-time high value and pasting it starting at cell A1 then use .Range("A1:A15").Select instead.

 

[bmx37]

Thanks a lot John.
Is it possible to paste the transposed content into different rows and columns or even workbook/sheet whenever it's required ?
Cheers

 

[bmx37]

I mean is it possible to transpose it "on a fly" and paste it into freely selected place/cell like with the "ctrl+v" shortcut ?

 

[John_w]

Yes, but you have to select the destination cell first.

Public Sub Manual_Copy_and_Transpose2()
    Dim destinationCell As Range
    Set destinationCell = ActiveCell
    With Worksheets("Sheet3")
        .Activate
        .Range("A1:A15").Copy  'only Market cap to All-time high copied and pasted here
    End With
    With destinationCell
        .Parent.Activate
        .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    End With
    Application.CutCopyMode = False
End Sub