Announcement

Collapse
No announcement yet.

Web Query From Multiple Cell References

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Web Query From Multiple Cell References



    In my first worksheet I have a list of states and state abrivations I want to refreence each of the states and return their results on a new worksheet. I've been able to scrap together most of the code, but i'm missing the first part of the code which declares the reference...I Think?!

    Looking forward to you input, thanks!

    Code:
            MyName = "Query" & State
            ConnectString = "URL;http://sites.target.com/site/en/spot/state_results.jsp?state=" & State
            ThisWorkbook.Worksheets.Add
            ActiveSheet.Name = State
     
            ' On the Workspace worksheet, clear all existing query tables
            For Each QT In ActiveSheet.QueryTables
                QT.Delete
            Next QT
     
            ' Define a new Web Query
            Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=Range("A1"))
            With QT
                .Name = MyName
                .FieldNames = True
                .RowNumbers = False
                .FillAdjacentFormulas = False
                .PreserveFormatting = True
                .RefreshOnFileOpen = False
                .BackgroundQuery = False
                .RefreshStyle = xlInsertDeleteCells
                .SavePassword = False
                .SaveData = True
                .AdjustColumnWidth = True
                .RefreshPeriod = 0
                .WebSelectionType = xlSpecifiedTables
                .WebFormatting = xlWebFormattingAll
                .WebTables = "5"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
            End With
     
            ' Refresh the Query
            QT.Refresh BackgroundQuery:=True
     
        Next State
     
    End Sub
    Joe Murphy
    www.retaillinkblog.com

  • #2
    Hi jpmurph,
    See attatched,please.
    Regards,Junho
    Attached Files

    Comment


    • #3
      Code:
      Sub querystates()
        states=split("Ohio,Michigan,California,Utah",",")
        for j=0 to ubound(states)
          With sheets.Add
             .Name = States(j)
       
              With .QueryTables.Add("URL;http://sites.target.com/site/en/spot/state_results.jsp?state" & States(j), Range("A1"))
                  .Name = "Query " & States(j)
                  .WebTables = "5"
                  .refresh false
              End With
         End With
       Next
       
      End Sub

      Comment


      • #4
        The worksheet attached works great thanks junho!

        But what would I have to change if I wanted to put all the results on the same worksheet, stacked on top of eachother. would I just need to remove the worksheets.add? I tried this but can't get it to work properly.

        Code:
        MyName = "Query" & State
                ConnectString = "URL;http://sites.target.com/site/en/spot/state_results.jsp?state=" & State
               
          ' On the Workspace worksheet, clear all existing query tables
                For Each QT In ActiveSheet.QueryTables
                    QT.Delete
                Next QT
         
                ' Define a new Web Query
                Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=Range("A1"))
                With QT
                    .Name = MyName
                    .FieldNames = True
                    .RowNumbers = False
                    .FillAdjacentFormulas = False
                    .PreserveFormatting = True
                    .RefreshOnFileOpen = False
                    .BackgroundQuery = False
                    .RefreshStyle = xlInsertDeleteCells
                    .SavePassword = False
                    .SaveData = True
                    .AdjustColumnWidth = True
                    .RefreshPeriod = 0
                    .WebSelectionType = xlSpecifiedTables
                    .WebFormatting = xlWebFormattingAll
                    .WebTables = "4"
                    .WebPreFormattedTextToColumns = True
                    .WebConsecutiveDelimitersAsOne = True
                    .WebSingleBlockTextImport = False
                    .WebDisableDateRecognition = False
                    .WebDisableRedirections = False
                End With
         
                ' Refresh the Query
                QT.Refresh BackgroundQuery:=True
         
            Next State
         
        End Sub
        Joe Murphy
        www.retaillinkblog.com

        Comment


        • #5
          For instance:

          Code:
          Sub querystates()
              States = Split("Ohio,Michigan,California,Utah", ",")
              With Sheets.Add
                  For j = 0 To UBound(States)
                      With .QueryTables.Add("URL;http://sites.target.com/site/en/spot/state_results.jsp?state" & States(j), Cells(.UsedRange.Rows.Count + 10, 1))
                          .Name = "Query " & States(j)
                          .WebTables = "5"
                          .Refresh False
                      End With
                  End With
              Next
          End Sub
          Regards,

          Wigi

          Excel MVP 2011-2014

          For more Excel memes: visit http://www.wimgielis.com ==> English articles ==> Excel memes

          -- Topics without [CODE] tags or a meaningful topic title, will be neglected by me (and probably many others as well) --

          Comment


          • #6


            Re: Web Query From Multiple Cell References

            Hi jpmurph,
            See if this works.
            Code:
            Sub Macro1()
                Dim rng As Range
                Dim c As Range
                Set rng = Sheet1.Range("A1").CurrentRegion.Columns(1)
                For Each c In rng.Areas(1)
                    State = c.Value
                    MyName = "Query" & State
                    ConnectString = "URL;http://sites.target.com/site/en/spot/state_results.jsp?state=" & State
                    If SheetExists(State) = False Then
                        ThisWorkbook.Worksheets.Add
                        ActiveSheet.Name = State
                        ' Define a new Web Query
                        Set QT = Sheets(State).QueryTables.Add(Connection:=ConnectString, Destination:=Sheets(State).Range("A1"))
                        With QT
                            .Name = MyName
                            .FieldNames = True
                            .RowNumbers = False
                            .FillAdjacentFormulas = False
                            .PreserveFormatting = True
                            .RefreshOnFileOpen = False
                            .BackgroundQuery = False
                            .RefreshStyle = xlInsertDeleteCells
                            .SavePassword = False
                            .SaveData = True
                            .AdjustColumnWidth = True
                            .RefreshPeriod = 0
                            .WebSelectionType = xlSpecifiedTables
                            .WebFormatting = xlWebFormattingAll
                            .WebTables = "4"
                            .WebPreFormattedTextToColumns = True
                            .WebConsecutiveDelimitersAsOne = True
                            .WebSingleBlockTextImport = False
                            .WebDisableDateRecognition = False
                            .WebDisableRedirections = False
                        End With
                        ' Refresh the Query
                        QT.Refresh BackgroundQuery:=True
                    Else
                        For Each QT In Sheets(State).QueryTables
                            QT.Refresh
                        Next QT
                    End If
                Next
            End Sub    'Joe Murphy
            Function SheetExists(State) As Boolean
                Dim wSheet As Worksheet
                On Error Resume Next
                Set wSheet = Sheets(State)
                If wSheet Is Nothing Then  'Doesn't exist
                    SheetExists = False
                    Set wSheet = Nothing
                    On Error GoTo 0
                Else    'Does exist
                    SheetExists = True
                    Set wSheet = Nothing
                    On Error GoTo 0
                End If
            End Function
            Regards, Junho

            Comment

            Working...
            X