Web Query Run-time Error

[AG]

I cobbled together code for queering multiple records from an online
database.

Sample below.

As the code runs, it eventually fills all the columns of my sheet named
"Data" and I get a Run-time error '1004" message as follows:

"Microsoft Excel cannot insert columns because the last column (column IV)
contains data. You will not get any data.

I got around the problem by clearing the sheet "Data" during the Do While
loop but is there a better way to code the properties of the query?



Sub GetInfo()

Sheets("Data").Select



' Sheet I use to collect the web data



Dim strURL As String

Dim rngLookUpSym As Range

Set rngLookUpSym = Worksheets("Value").Range("A3")

Do While rngLookUpSym <> ""

strURL = rngLookUpSym.Hyperlinks(1).Address

Sheets("Data").Activate



Cells.Select

Selection.ClearContents

' code I inserted to get around the problem



With ActiveSheet.QueryTables.Add(Connection:= _

"URL;" & strURL, Destination:=Range("A1"))

.Name = ""

.FieldNames = True

.RowNumbers = False

.FillAdjacentFormulas = False

.PreserveFormatting = True

.RefreshOnFileOpen = False

.BackgroundQuery = True

.RefreshStyle = xlInsertDeleteCells

.SavePassword = False

.SaveData = True

.AdjustColumnWidth = True

.RefreshPeriod = 0

.WebSelectionType = xlAllTables

.WebFormatting = xlWebFormattingNone

.WebPreFormattedTextToColumns = True

.WebConsecutiveDelimitersAsOne = True

.WebSingleBlockTextImport = False

.WebDisableDateRecognition = False

.Refresh BackgroundQuery:=False

End With

Set rngLookUpSym = rngLookUpSym.Offset(1, 0)

Application.Run "'Wheeling 2-07.xls'!Transfer"

Loop

End Sub



Thanks for any info,

Al