Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 08-25-2014, 10:01 AM
rogcar75 rogcar75 is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2010 32bit
Novice
Transferring info from 1column on sheet2 to sheet1
 
Join Date: Aug 2014
Location: OU Country
Posts: 15
rogcar75 is on a distinguished road
Default

Ok thanks again
I entered the duplicate names manually and rerun the script, and it updated it in sheet 1.


Also it said i had a error 438 in the script, it was highlighted it was in the
(v.Range("A1:O1000").ClearFomats), i just guessed that it was the fomats needed to be formats, and i changed it then i could re run the script.
I Got Lucky i guess, lol
Thanks Rog
Attached Files
File Type: xlsm Test20Aug2014 (1).xlsm (317.1 KB, 8 views)
Reply With Quote
  #17  
Old 08-25-2014, 12:13 PM
excelledsoftware excelledsoftware is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Oh man that's a super embarrassing typo.
Yes that is what needed to be done. Good job.
I will get the updated script to you as soon
As I am done with work.
Reply With Quote
  #18  
Old 08-25-2014, 03:29 PM
rogcar75 rogcar75 is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2010 32bit
Novice
Transferring info from 1column on sheet2 to sheet1
 
Join Date: Aug 2014
Location: OU Country
Posts: 15
rogcar75 is on a distinguished road
Default

I Didn't mean for it to be embarassing to you, sorry, i just wanted you to know what i did, in case it was wrong.
Rog
Reply With Quote
  #19  
Old 08-25-2014, 09:01 PM
excelledsoftware excelledsoftware is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Lol. Nothing to worry about. I have a habit of posting something and then proofreading it after. I need to stop doing that. When I posted that code I saw that I had wrote something incorrectly so I went to fix and made a typo. Pretty Funny.

Pasted below is the new code that will do the same thing but allow you to write a vlookup for the duplicates using the team initials. You will need to see what it looks like after the script runs but other than that it should be the very same.

Let me know if you have any other questions.

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, 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").ClearFormats
          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 & "_" & ws.Range("B" & rw).Value
        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(A4&B4,'Data Scrape'!C:O,13,0)")
      End If
      

End Sub
Reply With Quote
  #20  
Old 08-26-2014, 03:46 AM
rogcar75 rogcar75 is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2010 32bit
Novice
Transferring info from 1column on sheet2 to sheet1
 
Join Date: Aug 2014
Location: OU Country
Posts: 15
rogcar75 is on a distinguished road
Default

Ok thanks again

1 - I have installed the new Script, but i am not sure where the vlookup should be put at, and how, with the script, so that is one question?

2 - Is there a way in the script to change the #na that is showing up in the rows where players name don't have updates to their Player Value Column, maybe a $0.00 instead of the #na?

3 - Ok after all of this done, can the shape i created have to stay on sheet 1, or can I just add a shape whenever i run the script again?

4 - Also when the script is already ran and updated sheet 1, do i need to keep the datascrape sheet, and if i do, does it have to be in front of sheet 1 on the tabs below?
I know these questions are probably senseless, but i just want to clairfy what i can do and what i can't with the sheets, now with VBA scripts.

5 - And finally i just want to thank you for your time and what you do to help others out with these functions, your are truly Appreciated.
Thanks Rog
Reply With Quote
  #21  
Old 08-26-2014, 02:44 PM
excelledsoftware excelledsoftware is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

Hi Rogcar,

I will address each of these concerns.

1. the vlookup should stay in your first worksheet. You mentioned that you corrected the formula to work so you can use that same formula. The different part is if you get a #N/A from the lookup you can change just that lookup to include the team name as well. You will need to look at the red highlighted names to see what it changed the SearchString into.

2.Yes that is possible. You just need to change your formula to have IfError( in front of it. I believe the formula would be
Code:
=IfError(VLOOKUP(A4&B4,'Data Scrape'!C:O,13,0),0.00)
3.The shape does not have much to do with the script. It is just a way for you to run the script by clicking on it. You can place the shape anywhere in the workbook you like as long as you have assigned the macro to it, it will work.

4.The script will automatically create the DataScrape sheet if it is not there. However if you choose to delete while you have your vlookup formulas on your first sheet you will get a #REF error and will need to rewrite the formulas when the DataScrape Sheet is recreated. It does not matter where in the workbook the DataScrape sheet is you can move it to the end or do what you wish with it.

5.What a nice note. I appreciate the questions. I have a project for work coming up that needs this same type of coding so this is really good practice for me. Thank you for the kind words.
Reply With Quote
  #22  
Old 08-26-2014, 04:15 PM
rogcar75 rogcar75 is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2010 32bit
Novice
Transferring info from 1column on sheet2 to sheet1
 
Join Date: Aug 2014
Location: OU Country
Posts: 15
rogcar75 is on a distinguished road
Default

Ok, Thank You

One more question and i will quit asking questions, lol
I am still not sure where the vlookup goes for the Duplicates.
1 - Does it go in the Player Value formula, or create a formula for the team column, or where, and what should it include in the formula?

The search string is this:
YoungChris_Sea SP
Thanks again for your time.
Reply With Quote
  #23  
Old 08-26-2014, 05:07 PM
excelledsoftware excelledsoftware is offline Transferring info from 1column on sheet2 to sheet1 Windows 7 64bit Transferring info from 1column on sheet2 to sheet1 Office 2003
IT Specialist
 
Join Date: Jan 2012
Location: Utah
Posts: 455
excelledsoftware will become famous soon enough
Default

No problem ask away.

so you would change the vlookup on your first sheet to include all of the searchstring. Based off of the example you provided the formula would be something like
Code:
=VLOOKUP(A9&B9&"_"&E9&" "&F9,'Data Scrape'!C:O,13,0)
You need to get the first part of the vlookup to equal what the search string is. Once you get it to work you shouldnt need to update it again and when you run the script it will pull in this new formula. If that dosnt quite make sense PM me and well get it all sorted out.

Thanks
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Newbie to excel for starters, needing to transfer info from sheet2 to universe sheet. rogcar75 Excel 0 08-12-2014 07:21 AM
How to populate cells in Sheet2 with Data Source query using cell data from Sheet1 bobznkazoo Excel 2 03-27-2014 11:14 AM
split text files to worksheets (sheet1,sheet2,sheet3 soon sheet 25) gsrikanth Excel Programming 1 03-22-2012 11:04 PM
Transferring info from 1column on sheet2 to sheet1 arrows remain between task bars, but predecessor info disappears from task info Antares Project 1 12-14-2011 09:19 AM
Transferring info from 1column on sheet2 to sheet1 How to merge two cells from sheet1 to one cell in sheet2 in next sheet KIM SOLIS Excel 6 10-30-2011 11:14 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 09:37 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft