Simple VBA-problem/Web Query...

[sillo]

Hello guys,

I have a problem that I'm as complete beginner can't solve.

I'm quering information from a site at the form:

Band: U2
Album: Under The Red Sky
Song1: Hey Joe
Song2: Blue Boy
...

I've posted the code below:

Sub Macro2()
'
' Macro2Test Macro
'
'
   With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & ActiveSheet.Range("A4").Value, Destination:=Range("C4"))
        .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 = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

I would like to make ...Range("A4") to go to the active cell to colums to the right instead of "A4".

Also I would like the Destination:=Range("C4") to be displayed in a row active cell to the left(e.g. C4="Band: U2", "D4=Album: Under The Red Sky")
instead as it gets displayed now:
C4="Band: U2"
C5="Album: Under The Red Sky"

Any help would be greatly apprisiated.

Kind Regards / F

 

[sillo]

bump

 

[xenou]

Maybe post a sample of data as returned from the query, and then another how you'd like it to be.

It sounds like you want the records transposed (in a row instead of a column). Is that right? Does your query always return only a single record?

 

[sillo]

Thanks for your reply!

Yes that's correct, I want the records transposed (in a row instead of a column).

Yes my query only return one single record.

Instead of this

<table style="border-collapse: collapse; width: 312px; height: 76px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 48pt;" width="64" span="3"> <tbody><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 48pt;" width="64" height="20">Band:U2</td> <td style="width: 48pt;" width="64">
</td> <td style="width: 48pt;" width="64">
</td> </tr> <tr style="height: 15pt;" height="20"> <td colspan="3" style="height: 15pt;" height="20">Album: Under The Red Sky</td> </tr> <tr style="height: 15pt;" height="20"> <td colspan="2" style="height: 15pt;" height="20">Song1: Hey Joe</td> <td>
</td> </tr> </tbody></table>
I would like to have it like to have the results displayed as below:

<table style="border-collapse: collapse; width: 481px; height: 36px;" border="0" cellpadding="0" cellspacing="0"><col style="width: 46pt;" width="61"><col style="width: 130pt;" width="173"><col style="width: 75pt;" width="100"><tr style="height: 15pt;" height="20"> <td style="height: 15pt; width: 46pt;" width="61" height="20">Band: U2</td> <td style="width: 130pt;" width="173">Album: Under The Red Sky</td> <td style="width: 75pt;" width="100">Song1: Hey Joe</td> </tr></table>
I really appreciate any idea how to solve this.

Regards / F

 

[sillo]

Hi again,

I solved the first part of my inquiry, se below:

Sub Macro1()
'
' Macro2Test Macro
'
'
   With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & ActiveCell.Offset(0, -2).Value, Destination:=ActiveCell.Offset(0, 2))
        .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 = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
End Sub

Now I just need the results to be displayed in a row instead of in a column.

Anyone's got any idea how to solve this?

 

[xenou]

I don't know if you can get the query to return the values in the arrangement you want without some fancy stuff (such as parsing the HTML itself or something like that).

You could however continue with the vba to "clean up" and do the re-arranging. I captured the ActiveCell as "XCell" in order to more easily store the address of where the data is going to...


Also (I'm Not used to dealing with these styles of queries but) it may be good to delete the query table after your done - if you are adding many queries tables they could start piling up and using workbook memory.

Sub Macro1()
'
' Macro2Test Macro
'
'
[COLOR="Blue"]
Dim XCell As Range

Set XCell = ActiveCell[/COLOR]

   With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & [COLOR="#0000ff"]XCell[/COLOR].Offset(0, -2).Value, Destination:=[COLOR="#0000ff"]XCell[/COLOR].Offset(0, 2))
        .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 = "2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

XCell.Offset(0,2).Offset(1,0).Copy _
    Destination:=XCell.Offset(0,2).)Offset(1,0) '[COLOR="SeaGreen"]//Move album to same Row as Band[/COLOR]
XCell.Offset(0,2).Offset(2,0).Copy _
    Destination:=XCell.Offset(0,2).)Offset(2,0) [COLOR="#2e8b57"]'//Move song1 to same Row as Band[/COLOR]

XCell.Offset(0,2).Offset(1,0).ClearContents [COLOR="#2e8b57"]'//Clear original album cell[/COLOR]
XCell.Offset(0,2).Offset(2,0).ClearContents [COLOR="#2e8b57"]'//Clear original song1 cell[/COLOR]

End Sub

Edit:
Maybe at the end of your code add (if there's no query tables that need to be saved) (not sure but could save workbook bloat):

Dim QT as QueryTable
For Each QT in Activesheet.QueryTables
    QT.Delete
Next QT

 

[sillo]

It works as a charm!

Thank you very much for taking time to help me!

Regards / F