Can't figure out why code won't work?

jmp14

New member
Joined
Oct 29, 2014
Messages
13
Reaction score
0
Points
0
Code is not pulling data from web as it should. Any advice is greatly appreciated!



Code:
Sub Macro1()
'
' Macro1 Macro
'

'
    Sheets("Sheet1").Select
    Range("A1").Select

Dim i As Integer, myurl As String

i = 1
Do While i > 200000

myurl = "URL;urlstingwouldgohereandendswith:productId=" & i & ""

    With ActiveSheet.QueryTables.Add(Connection:=myurl, Destination:=Range("$A$1"))
        .Name = shorturl
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    
        Columns("A:J").Select
    Selection.Copy
    Range("K1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("A:J").Select
    Range("J1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

Columns("A:J").Select
    Selection.ColumnWidth = 20.01
    Columns("B:B").Select
    Selection.ColumnWidth = 20.01

    Rows("1:300").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

    i = i + 1
  
Loop
End Sub
 
Last edited by a moderator:
The issue is here:
Code:
i = 1
Do While i [COLOR=#ff0000][B]>[/B][/COLOR] 200000
Should be < not > ;)
 
Doesn't sound very sensible to add 200000 querytables to a workbook....

Avoid any 'select' and 'activate' in VBA.
 
They get deleted each time.
 
Hmm well I had it at "<" haha and it was giving me errors because there are no valid urls until the end number is at least 20000 so I just figured. . . . .

How else can I get it to understand all valid integers? Or should I just let it run, I think it would take weeks though!
 
Code:
Sub M_snb()
  with sheet1.QueryTables.Add("URL;urlstingwouldgohereandendswith:productId=200000", Range("$A$1"))
    .Refresh False
  End With 

  for j=200001 to 200020
    sheet1.cells(rows.count,15).end(xlup).offset(1).resize(,10)=sheet1.Range("A1:J1").value
    sheet1.Querytables(1).connection="urlstingwouldgohereandendswith:productId=" & j
    sheet1.Querytables(1).refresh false
  next
End Sub
 
Code:
Sub M_snb()
  with sheet1.QueryTables.Add("URL;urlstingwouldgohereandendswith:productId=200000", Range("$A$1"))
    .Refresh False
  End With 

  for j=200001 to 200020
    sheet1.cells(rows.count,15).end(xlup).offset(1).resize(,10)=sheet1.Range("A1:J1").value
    sheet1.Querytables(1).connection="urlstingwouldgohereandendswith:productId=" & j
    sheet1.Querytables(1).refresh false
  next
End Sub


This one is throwing me errors. I either get "Run-time error '1004' Application-defined or oject defined error" for this line: "connection="urlstingwouldgohereandendswith:productId=" & j"

Or if I try to modify it, it errors out saying it cannot retrieve data. :frusty:

I will try to work on it a bit more with all of your advice so far however!
 
Not every ProdId is valid:

Code:
Sub M_snb()
  On Error Resume Next
  
  Sheet1.QueryTables.Add("URL;http://catalog.bd.com/nexus-ecat/getProductDetail?productId=211520", Range("$A$1")).Refresh False
  
  For j = 0 To 10
    If Err.Number = 0 Then Sheet1.Cells(Rows.Count, 15).End(xlUp).Offset(2).Resize(11, 2) = Sheet1.Range("A1:B11").Value

    Err.Clear
    Sheet1.QueryTables(1).Connection = "URL;http://catalog.bd.com/nexus-ecat/getProductDetail?productId=" & j + 211520
    Sheet1.QueryTables(1).Refresh False
  Next
End Sub
 
Wouldn't it be better to use
Code:
Dim j As Integer
? I know not all numbers will be valid but I need to be able to capture all that are.

Or if I have a specific list could I incorporate that? (ie, 215123, 292631, 257437 etc.)

I also don't get why yours only copied the last table and not the whole page of data.
 
Declaring the variable has no effect on the macro.

A list of valid numbers can be stored in an array.

The whole page (is that necessary ?) can be retrieved using the property


Code:
.WebSelectionType = xlEntirePage
 
Declaring the variable has no effect on the macro.

A list of valid numbers can be stored in an array.

The whole page (is that necessary ?) can be retrieved using the property


Code:
.WebSelectionType = xlEntirePage


I had that code within my original code. You'll have to elaborate more about an array. It's more than I know. I'm pretty good at VBA but still have a lot to learn, and this task in general I'm finding to be quite a bit complicated. I appreciate your time in helping me understand.
 
Back
Top