Web Query To a Userform

[Kdilas]

Hello All,
I have just started messing with the web query function in excel and am wondering if its possible to put the results of a web query on a userform. When a button is pushed id like to have a userform pop up showing the results of a web query which i have predefined. any help here would be greatly appreciated..

 

[Kdilas]

This is what I came up with If Anyone Is interested. Its a combination of code found on this site and the macro recorder.

Private Sub UserForm_Initialize()
Dim BB As String
On Error Resume Next
Application.ScreenUpdating = False
Workbooks.Add
BB = ActiveWorkbook.Name
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Web Query"
        With ActiveSheet.QueryTables.Add(Connection:= _
            "URL;http://tracker.hitechmold.com/ToolTracker/framework/main1.asp", _
            Destination:=Range("$A$1"))
            .Name = "main1"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .BackgroundQuery = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .WebSelectionType = xlSpecifiedTables
            .WebFormatting = xlWebFormattingNone
            .WebTables = "10"
            .WebPreFormattedTextToColumns = True
            .WebConsecutiveDelimitersAsOne = True
            .WebSingleBlockTextImport = False
            .WebDisableDateRecognition = False
            .WebDisableRedirections = False
            .Refresh BackgroundQuery:=False
        End With
lastrow = Range("A" & Rows.Count).End(xlUp).Row
        With ListBox1
            .ColumnCount = 4
            .ColumnWidths = "60;40;600;40" 'points
            .BoundColumn = 1    'if it's bound to a cell, column 1  is returned
            .ControlSource = "Web Query!E2"
            .RowSource = "A1:D1" & lastrow 'The array of cells that provide values
        End With
Workbooks(BB).Saved = True
Workbooks(BB).Close
Application.ScreenUpdating = True
End Sub
[code]

 

[Kdilas]

Below is updated code. I was having a problem when scrolling the listbox on the userform all the data went nuts. I have hidden the sheet and now dont close it until the user closes the userform.





[Dim BB As String
Private Sub UserForm_Initialize()
On Error Resume Next
Application.ScreenUpdating = False
Workbooks.Add
BB = ActiveWorkbook.Name
Sheets("Sheet1").Select
Sheets("Sheet1").Name = "Web Query"
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://tracker.hitechmold.com/ToolTracker/framework/main1.asp", _
Destination:=Range("$A$1"))
.Name = "main1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
LastRow = Range("A" & Rows.Count).End(xlUp).Row
With ListBox1
.ColumnCount = 4
.ColumnWidths = "60;40;600;40" 'points
.BoundColumn = 1 'if it's bound to a cell, column 1 is returned
.ControlSource = "Web Query!E2"
.RowSource = "A1:D1" & LastRow 'The array of cells that provide values
End With
Windows(BB).Visible = False
End Sub



Private Sub UserForm_QueryClose(cancel As Integer, closemode As Integer)
Workbooks(BB).Saved = True
Workbooks(BB).Close
Application.ScreenUpdating = True
End Sub]