Dynamic web query

[eznsd]

I am trying to automate the process of retrieving data for a bill of materials. My workbook is organized with the clean bill of materials on sheet1, titled BOM. On sheet2, I have formulas to extract the information from sheet1 and generate the URL for each part. I recorded a macro to perform a web query for the first part in the list and imported webtable #2. I imported the query into cells W1:AA13. The data of interest to me is contained in cells X5 and Z4. The URL starts in K3 and could be up to 200 parts. I do remove any empty rows and and convert the formulas into text. I would also need to delete the query so the next part's query could be in the same position. I would like to paste the X5 value into H3 and the Z4 value into I3 but I have not had any succes so far. Is there anyone who can guide me in the right direction? Thanks in advance!

 

[jakeman]

Did your query work for the part you sampled? Can you post it?

 

[eznsd]

I saw this approach used in one of the many threads I have read and thought it might solve my problem. The first attempt kept crashing excel until I commented out the lines near the bottom. It continued to crash, but I saw there were new connections and that the URL was looking for MyCell. I just added the .Value but I havent't tested it yet.


Sub DKPN()
'
' DKPN Macro
'
'
Dim MyCell As Integer
For Each MyCell In Range("K3:K202")

With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.digikey.com/product-search/en?stock=1&keywords=MyCell.Value", _
Destination:=Range("$V$6"))
.Name = "en?stock=1&keywords=&MyCell.Value"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "2"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("X5").Select
ActiveCell.Copy
Range("H3").Select
ActiveCell.PasteSpecial
Range("Z4").Select
ActiveCell.Copy
Range("I3").Select
ActiveCell.PasteSpecial
'ActiveCell.FormulaR1C1 = "0.1"
'ActiveCell.Offset(-3, -16).Range("A1").Select
'ActiveSheet.Paste
'ActiveCell.Offset(0, 13).Range("A1:E13").Select
Range("W1:AA13").Select
Selection.ClearContents
Next MyCell
End Sub
[/CODE]

 

[eznsd]

I had made quick corrections to the code when I posted it previously. This is a cleaner version. Glad to see that this time the code markings worked!

Sub DKPN()
'
' DKPN Macro
'
'
    Dim MyCell As Variant
    For Each MyCell In Range("C3:C202")
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.digikey.com/product-search/en?stock=1&keywords=&MyCell.Value", _
        Destination:=Range("$W$1"))
        .Name = "en?stock=1&keywords=&MyCell.Value"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Range("X5").Select
    ActiveCell.Copy
    Range("H3").Select
    ActiveCell.PasteSpecial
    Range("Z4").Select
    ActiveCell.Copy
    Range("I3").Select
    ActiveCell.PasteSpecial
    'ActiveCell.FormulaR1C1 = "0.1"
    'ActiveCell.Offset(-3, -16).Range("A1").Select
    'ActiveSheet.Paste
    'ActiveCell.Offset(0, 13).Range("A1:E13").Select
    Range("W1:AA13").Select
    Selection.ClearContents
    Next MyCell
End Sub

 

[jakeman]

I'm wondering about the .name formula...have you tested that out to see if it's actually working?

try this:

Sub DKPN()'
' DKPN Macro
'
'
    Dim MyCell As Variant
    
    For Each MyCell In Range("C3:C202")
    With ActiveSheet.QueryTables.Add(Connection:="URL;http://www.digikey.com/product-search/en?stock=1&keywords=&MyCell.Value", Destination:=Range("$W$1"))
        .Name = "en?stock=1&keywords=&MyCell.Value"
        MsgBox .Name
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = False
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlSpecifiedTables
        .WebFormatting = xlWebFormattingNone
        .WebTables = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
    Range("X5").Value = Range("H3").Value
    Range("Z4").Value = Range("I3").Value
    Range("W1:AA13").Select
    Selection.ClearContents
    Next MyCell
    
End Sub

 

[jakeman]

I'm not sure that the way you have .Name pulling that it is correct...shouldn't you assign a text string to store that name? I was trying to find an example of something I used before...might have it at home.

 

[eznsd]

Yes, Jake, I verified that it was not working before I left work yesterday. I start work rather early so I am leaving for the day rather early. It struck me last night that I may want to loop the section after the "End With" to get the correct row numbers for the pasting. The way it is now, the data will only be placed in H3 and I3 and not on the correct row. I do appreciate your input!

 

[jakeman]

As far as the text string for the URL, i did something like this before for a fantasy bball web update:

    monthURLstring = Format(day, "mm")
    dayURLstring = Format(day, "dd")
    yearURLstring = Format(day, "yyyy")
   
    URLString = "month=" & monthURLstring & "&day=" & dayURLstring & "&year=" & yearURLstring

    MsgBox "Don't worry, bwana.  The data will take a little bit of time to run so just grab a Pabst and chill."

    Application.ScreenUpdating = False

    Workbooks.Add

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;[url=http://www.basketball-reference.com/friv/dailyleaders.cgi]NBA Daily Stats Leaders for November 10, 2015 | Basketball-Reference.com[/url]?" & URLString & "", Destination:=Range("$A$1"))
        .FieldNames = True
        .RowNumbers = False

Not sure if that would help you with how to put it together.

 

[eznsd]

Thanks Jake. I think the .Name will give me problems as it is naming W1. I still haven't figured out why it is not getting the data from the cells.

 

[eznsd]

After further testing, it does not appear that the .Name will give me problems. I still do not understand why the URL is not completing. The first MsgBox returns the correct part number but the second just increments the PN, as in PN_1, PN_2, e.t.c.. Any help would be appreciated!

    Dim MyCell As Variant
    Dim PN As String
    
    For Each MyCell In Range("C3:C202")
    PN = MyCell.Value
    MsgBox PN
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.digikey.com/product-search/en?stock=1&keywords=&PN", _
        Destination:=Range("$W$1"))
        .Name = "en?stock=1&keywords=&PN"
        MsgBox .Name
        .FieldNames = True
        .RowNumbers = False