Done. I was feeling really nice. This script will do the following:
It will automatically open up the webpage and put that data into a worksheet. This worksheet will be formatted in a way that will allow you to use a vlookup on your first sheet by just putting the 2 names together. If you have more than 1 URL to do let me know and I will make a small change to the code that will allow you to do as many URLs as you like without ever having to copy and paste the data.
Code:
Option Explicit
Sub PlayerRaterParser()
'Extracts the data from a set of webpages and exports the data out
Dim ie As Object, NameText As Object, NameDesText As Object
Dim TableText As Object, v As Variant, LastRow As Long
Dim rw As Long, Col As Long, LastCol As Long, DsExists As Boolean
Dim DuplicateCheck As Long, DuplicateIssue As Boolean, DupString As String
Dim CheckString As String, NewString As String
Dim wb As Workbook, ws As Worksheet, rws As Worksheet, uws As Worksheet
Set wb = ThisWorkbook
'Make sure the scrape sheet exists
Application.DisplayAlerts = False
For Each v In wb.Worksheets
If v.Name = "Data Scrape" Then
v.Range("A:Z").ClearContents
v.Range("1:1").Font.Bold = True
DsExists = True
End If
Next v
Application.DisplayAlerts = True
If DsExists = False Then
Sheets.Add
ActiveSheet.Name = "Data Scrape"
End If
Set ws = wb.Worksheets("Data Scrape")
ws.Activate
'Create the IE object to use
Set ie = CreateObject("InternetExplorer.application")
ie.Visible = True
ie.Navigate "http://games.espn.go.com/flb/playerrater"
Do While ie.ReadyState <> 4 'Make sure page loads
DoEvents
Loop
'grab the needed HTML
Set NameText = ie.Document.GetElementsByClassName("flexpop")
Set NameDesText = ie.Document.GetElementsByClassName("playertablePlayerName")
Set TableText = ie.Document.GetElementsByClassName("playertableData")
rw = 2
For Each v In NameText
ws.Range("A" & rw).Value = v.innertext
If v.innertext <> "" Then
rw = rw + 1
End If
Next v
rw = 2
For Each v In NameDesText
If v.innertext <> "" Then
ws.Range("B" & rw).Value = Replace(v.innertext, ws.Range("A" & rw).Value & ", ", "")
rw = rw + 1
End If
Next v
'Fill in the table data
LastCol = 15
Col = 4
rw = 1
For Each v In TableText
ws.Cells(rw, Col).Value = v.innertext
If Col = LastCol Then
Col = 4
rw = rw + 1
Else
Col = Col + 1
End If
Next v
ws.Range("A1").Value = "Player Name"
ws.Range("B1").Value = "Team POS"
'Clean up
ie.Quit
Set ie = Nothing
'Create a LookupString
LastRow = ws.Range("A50000").End(xlUp).Row
ws.Range("C:C").Font.ColorIndex = 5
ws.Range("C1").Value = "LookupString"
'Remove the space
For rw = 2 To LastRow
CheckString = ws.Range("A" & rw).Value
NewString = Mid(CheckString, InStr(1, CheckString, " ") + 1)
NewString = NewString & Mid(CheckString, 1, InStr(1, CheckString, " ") - 1)
ws.Range("C" & rw).Value = NewString
Next rw
'Check for any duplicates
For rw = 2 To LastRow
DuplicateCheck = WorksheetFunction.CountIf(ws.Range("C:C"), ws.Range("C" & rw).Value)
If DuplicateCheck > 1 Then
DupString = DupString & "Row " & rw
End If
Next rw
If DupString <> "" Then
MsgBox "You have duplicates on the following row(s): " & DupString & vbLf & _
"Your Vlookup will not work unless you change these values"
End If
End Sub
Thanks