Page 1 of 2 1 2 LastLast
Results 1 to 10 of 14

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

  1. #1

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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 Bob Phillips; 2015-01-05 at 10:11 PM. Reason: Added code tags

  2. #2
    Super Moderator JoePublic's Avatar
    Join Date
    Sep 2011
    Location
    Askew
    Posts
    170
    Articles
    0
    The issue is here:
    Code:
    i = 1
    Do While i > 200000
    Should be < not >
    Circumference of a circle = 2πrē



    ēthe circle's radius

  3. #3
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    370
    Articles
    0
    Excel Version
    2020
    Doesn't sound very sensible to add 200000 querytables to a workbook....

    Avoid any 'select' and 'activate' in VBA.

  4. #4
    Super Moderator JoePublic's Avatar
    Join Date
    Sep 2011
    Location
    Askew
    Posts
    170
    Articles
    0
    They get deleted each time.
    Circumference of a circle = 2πrē



    ēthe circle's radius

  5. #5
    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!

  6. #6
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    370
    Articles
    0
    Excel Version
    2020
    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

  7. #7
    Quote Originally Posted by snb View Post
    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="urlstingwouldgohereandendswithroductId=" & j"

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

    I will try to work on it a bit more with all of your advice so far however!

  8. #8
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    370
    Articles
    0
    Excel Version
    2020
    Show us 1 valid URL address to test.

  9. #9
    Quote Originally Posted by snb View Post
    Show us 1 valid URL address to test.

    Here ya go:
    http://catalog.bd.com/nexus-ecat/get...oductId=211520


    I'm still new to the site so it wasn't letting me post urls initially. . .

  10. #10
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    370
    Articles
    0
    Excel Version
    2020
    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

Page 1 of 2 1 2 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •