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, x As Integer
  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, UrlArray(0 To 15) As String
  Dim StartRow As Long, Complete As String, GiveFormula As Boolean
  Dim wb As Workbook, ws As Worksheet, rws As Worksheet, uws As Worksheet
  
  GiveFormula = True
  
    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("A1:O1000").ClearContents
          v.Range("A1:O1000").ClearFomats
          v.Range("1:2").Font.Bold = True
          DsExists = True
        End If
      Next v
    
      If DsExists = False Then
        Sheets.Add
        ActiveSheet.Name = "Data Scrape"
      End If
      
    Set ws = wb.Worksheets("Data Scrape")
    ws.Range("1:2").Font.Bold = True
    ws.Activate

    
    UrlArray(0) = "http://games.espn.go.com/flb/playerrater"
    UrlArray(1) = "http://games.espn.go.com/flb/playerrater?startIndex=50"
    UrlArray(2) = "http://games.espn.go.com/flb/playerrater?startIndex=100"
    UrlArray(3) = "http://games.espn.go.com/flb/playerrater?startIndex=150"
    UrlArray(4) = "http://games.espn.go.com/flb/playerrater?startIndex=200"
    UrlArray(5) = "http://games.espn.go.com/flb/playerrater?startIndex=250"
    UrlArray(6) = "http://games.espn.go.com/flb/playerrater?startIndex=300"
    UrlArray(7) = "http://games.espn.go.com/flb/playerrater?startIndex=350"
    UrlArray(8) = "http://games.espn.go.com/flb/playerrater?startIndex=400"
    UrlArray(9) = "http://games.espn.go.com/flb/playerrater?startIndex=450"
    UrlArray(10) = "http://games.espn.go.com/flb/playerrater?startIndex=500"
    UrlArray(11) = "http://games.espn.go.com/flb/playerrater?startIndex=550"
    UrlArray(12) = "http://games.espn.go.com/flb/playerrater?startIndex=600"
    UrlArray(13) = "http://games.espn.go.com/flb/playerrater?startIndex=650"
    UrlArray(14) = "http://games.espn.go.com/flb/playerrater?startIndex=700"
    UrlArray(15) = "http://games.espn.go.com/flb/playerrater?startIndex=750"

      

    'Create the IE object to use
    Set ie = CreateObject("InternetExplorer.application")
    ie.Visible = True
    
    For x = 0 To 15
      StartRow = ws.Range("A50000").End(xlUp).Row + 1
      ie.Navigate UrlArray(x)
        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 = StartRow + 1
      ws.Range("A" & StartRow).Select
        For Each v In NameText
          ws.Range("A" & rw).Value = v.innertext
          If v.innertext <> "" Then
            rw = rw + 1
         End If
        Next v
      rw = StartRow + 1
        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 = StartRow
      
        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
      Next x
      
      'All data scraped
            

            
      'Clean up
      ie.Quit
      Set ie = Nothing
      
    'Create a LookupString
      LastRow = ws.Range("A50000").End(xlUp).Row
      
      ws.Range("C:C").Font.ColorIndex = 5
      
      
      'Clear out the extra headers
      ws.Range("A1").EntireRow.Delete
      For rw = 2 To LastRow
        ws.Range("C" & rw).Select
        If ws.Range("D" & rw).Value = "RNK" Then
          ws.Range("D" & rw).EntireRow.Delete
          rw = rw - 1
        End If
      Next rw
      ws.Range("A1").Value = "Player Name"
      ws.Range("B1").Value = "Team POS"
      ws.Range("C1").Value = "LookupString"
      LastRow = ws.Range("A50000").End(xlUp).Row
    '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 & ", "
          ws.Range("A" & rw & ":C" & rw).Interior.Color = vbRed
        End If
      Next rw
      
      'Create new names
      For rw = 2 To LastRow
        If ws.Range("C" & rw).Interior.Color = vbRed Then
          ws.Range("C" & rw).Value = ws.Range("C" & rw).Value & "_" & rw
        End If
      Next rw
      
      ws.range("A1").Select
      
      If DupString <> "" Then
        MsgBox "You have duplicates on the following row(s): " & DupString & vbLf & _
        "These cells have been highlighted red and the name has been changed." & vbLf & _
        "These will not lookup and will need to be entered manually."
      End If
      
      If GiveFormula = True Then
        Complete = InputBox("Please copy and paste this formula into your worksheet now.", _
        Default:="=VLOOKUP(A3&B3,'Data Scrape'!C:O,13,0)")
      End If
      

End Sub