Copy, paste, then sort using VBA

[Burrgogi]

Every once in a while Fanatical (website) runs a bundle sale. It's listed in this format:


When I copy & paste this manually into Excel, (Ctrl + C, then Ctrl + V), it looks just fine. See 2nd screenshot. I tried to write up a quick VBA solution to this repetitive process and I've run into a slight problem. The VBA routine tries to cram everything into cell A1 which is incorrect. I'm not versed enough with VBA to correct this problem. Also if someone can help me sort the table from highest to lowest using the Steam user rating column shown in percentage, I'd really appreciate it! EDIT: I know how to sort in Excel, I'm asking how to incorporate that into my current VBA routine.

Here's my code:

Sub Paste_newSale()
   Sheets("Sheet").Copy , Sheets(Sheets.Count)
   ActiveSheet.Name = Format(Date, "dd_mm_yyyy")
Dim DataObj As MSForms.DataObject
Set DataObj = New MSForms.DataObject
DataObj.GetFromClipboard
SText = DataObj.GetText(1)
ActiveSheet.Range("A2").Value = SText
End Sub

 

[Marc L]

​

Any source URL ?​

 

[Burrgogi]

​

Any source URL ?​

Here.

 

[Marc L]

The old Reddit ! Thinking it was dead …​

​

Does the worksheet result need to keep the original links of each Title ?​

 

[Burrgogi]

Does the worksheet result need to keep the original links of each Title ?​

It would be nice to have but not necessary.

 

[Marc L]

As this solution belongs to good enough readers …​

A VBA demonstration as a beginner starter to paste to the result worksheet module :​

Sub DemoReq1()
    With CreateObject("WinHttp.WinHttpRequest.5.1")
        .Open "GET", "https://old.reddit.com/r/GameDeals/comments/nc9ypj/fanatical_staff_picks_build_your_own_bundle_may/", False
        .setRequestHeader "DNT", "1"
         On Error Resume Next
        .send
         If .Status = 200 Then T$ = .responseText
    End With
         On Error GoTo 0
    If T = "" Then
        Beep
    Else
        With CreateObject("htmlfile")
                 .body.innerHTML = T
            With .getElementsByTagName("TABLE")
                If .Length > 3 Then
                    With .Item(3)
                        If .document.frames.clipboardData.setData("Text", .outerHTML) Then
                            UsedRange.Clear
                            Application.ScreenUpdating = False
                            Paste [A1]
                            UsedRange.WrapText = False
                            UsedRange.Columns.AutoFit
                            UsedRange.Sort [C1], 2, Header:=1
                            Application.ScreenUpdating = True
                           .document.frames.clipboardData.clearData "Text"
                        End If
                    End With
                End If
            End With
        End With
    End If
End Sub

 

[Burrgogi]

I got an error message:

compile error: Sub or Function not defined

Paste [A1]

 

[Marc L]

​

As it rocks on my side … Where is located the VBA procedure ? Excel version ?​

 

[Burrgogi]

​

As it rocks on my side … Where is located the VBA procedure ? Excel version ?​

I saved the VBA procedure in "ThisWorkbook"

Excel version 2010. It's also displayed in my profile.

EDIT:

OK I just inserted a new worksheet and saved the routine there. The code ran just fine.

Wonder why it doesn't work when I save it to "ThisWorkbook". Ideally I need it to be saved there because my workbook is a running tally of all the sales Fanatical has had this year.

 

[Marc L]

​

We have a winner ‼ Same player read again post #6 but well this time as never the workbook module was stated​

​

Spoiler

but the worksheet module …