Looping Marco thur url

[sandy armstrong]

Hello, I have create a marco that will go on a site and extract data. thru a web query.
I would like it to keep looping through the column that has all the urls. and stop at the last row containing a url...

SO....
Column K has the URLS starting at K2 these urls come in because a rss feed

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+L
'
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.practicelink.com/jobs/297594/RSS/Physician/Cardiology/OH/Genesis%20HealthCare%20System" _
, Destination:=Range("$O$2"))
.Name = "Genesis%20HealthCare%20System"
.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 = "6"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
End Sub

when the data is brought back into excel it transposes accross colums O-Y

Please help me solve the mind twister !!!!

[Guido Geurs]

This will loop through the col:

         Range("K2").Activate
         Do While ActiveCell.Value <> ""
            ......
            'Do things
            ......
            ActiveCell.Offset(1, 0).Activate
         Loop

[sandy armstrong]

Thanks Guido, It loops pefectly but i would like to be able to do once it loops through the first url it opens web query and imports some data and transposes it across columnns O-Y and keeps doing these step over and over until it reaches the last entry.
i would like to show what i mean but this is a very confidental list of names cleint that i can not put on this site...
But if this is something that can be done Guido, I really do appreciate the help...

[Guido Geurs]

Just write your code in the 3 lines I have added with :

......
'Do things
......

If You need help, can't you attach a workbook with fictive names like Piet, Jan, ... and data ?
Just to see the structure of the sheet, what is on which place and where data need to be added?
Keep in mind that I can't use the web query ? or well ?

[sandy armstrong]

It worked for the first one brought the data in but it will not do it for the ones after that i going to try to attach the file i know last time there was some issues with that. Also im Rssfeeds i have in this file stopped updating as well.
Thanks Guido for you fast respones like always!!!!!

[Guido Geurs]

Sorry but I have troubles loading it in Office 2003.
Is it possible to attach a file with less data like only the sheet with a row or 10 and the VBA macros ?

[sandy armstrong]

Okay i down sized the file thanks again

[Guido Geurs]

This macro will search the data.
I have put the results in col "O" with a space of 10 rows.
Just set the results on the right location in the sheet.

Sub Macro1()
'
' Macro1 Macro
'
' Keyboard Shortcut: Ctrl+Shift+L
'
Dim ARRURL() As String
Dim URLNAME As String
Dim QTidx As Integer
'§ go to first cell
    Range("K2").Activate
'§ loop through sheet
    Do While ActiveCell.Value <> ""
        '§ split URL on "/" in array
        ARRURL = Split(ActiveCell.Value, "/")
        With ActiveSheet.QueryTables
            With .Add(Connection:="URL;" & ActiveCell.Value, _
                        Destination:=Range("$O" & ActiveCell.Row * 10))
                '§ search .Name !! URL can or can NOT end on "/"
                If InStrRev(ActiveCell.Value, "/") = Len(ActiveCell.Value) Then
                    .Name = ARRURL(UBound(ARRURL) - 1)
                Else
                    .Name = ARRURL(UBound(ARRURL))
                End If
                .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 = "6"
                .WebPreFormattedTextToColumns = True
                .WebConsecutiveDelimitersAsOne = True
                .WebSingleBlockTextImport = False
                .WebDisableDateRecognition = False
                .WebDisableRedirections = False
                .Refresh BackgroundQuery:=False
            End With
            '§ clear QueryTables
            For QTidx = .Count To 1 Step -1
                .Item(QTidx).Delete
            Next
        End With
        With ActiveCell
            .Offset(1, 0).Activate
        End With
    Loop
End Sub

[sandy armstrong]

OmG!!!! this working Perfect!!! thank you i i am now closer then every i would like to know if how do i transpose the data when it extracts it out of the web.

[sandy armstrong]

Thanks Guido you rock!!!

[Guido Geurs]

Place the data in a NamedRange on the sheet.
I have placed it in "=CHS!$O$10:$P$ 20" for testing but you have to place it somewhere out of the used colls like "=CHS!$AA$1:$AB $10" or so.
Because the items are not always on the same place (more than one "Contact:" , more than one "Phone:"
number,...) we have to analise the data and place it on the right cell.
I have used 4 cols for "Contact:" and 2 for "Phone:"
You can change this number if there are URL with more data: just insert a Case in the right item and increase the numbers in the next items..

        '§ set data in cells and go 1 cell down
        With ActiveCell
            '§ move data
            For URLDATArow = 1 To Range("URLdata").Rows.Count
                URLDATAdata = Range("URLdata").Cells(URLDATArow, 2).Value
                If URLDATAdata <> "" Then
                    If Range("URLdata").Cells(URLDATArow, 1).Value <> "" Then
                        URLDATAitem = Range("URLdata").Cells(URLDATArow, 1).Value
                        URLDATAitemline = 1
                    Else
                        URLDATAitemline = URLDATAitemline + 1
                    End If
                    Select Case URLDATAitem
                    Case "Contact:"
                        Select Case URLDATAitemline
                        Case 1
                            .Offset(0, 4).Value = URLDATAdata
                        Case 2
                            .Offset(0, 5).Value = URLDATAdata
                        Case 3
                            .Offset(0, 6).Value = URLDATAdata
                        Case 4
                            .Offset(0, 7).Value = URLDATAdata
                        End Select
                    Case "Type of Recruiter:"
                        .Offset(0, 8).Value = URLDATAdata
                    Case "Phone:"
                        Select Case URLDATAitemline
                        Case 1
                            .Offset(0, 9).Value = URLDATAdata
                        Case 2
                            .Offset(0, 10).Value = URLDATAdata
                        End Select
                    Case "Fax:"
                        .Offset(0, 11).Value = URLDATAdata
                    Case "Search Firm:"
                        .Offset(0, 12).Value = URLDATAdata
                    End Select
                End If
            Next
            '§ go 1 cell down
            .Offset(1, 0).Activate
        End With
        ActiveSheet.Range("URLdata").Clear

[sandy armstrong]

Thanks again Guido, for this. I love how it is working... I just have one more question, If thats ok? I would like to know if change the rss feed for another company besides CHS how can i change the code to do the same thing no matter what company it is. The first time you did i was able to change the name of the rss feed to any company but the imported data was not transposing like how it is now" Application-defined or object- defined error is the message i get when i try to change the company name.
Again thanks for your help.

[Guido Geurs]

You have to look how the HTML page is structured!
If you are using IE than click on: Menu - View - Source or save page to your disk and look at it with an HTML viewer, MSword...
Tables can have a name like table 1 in RSS:

....
    <table id="[B]LogInDialog[/B]" style="dis....

And you can address it with:

 .WebTables = "1"

or

 .WebTables = "LogInDialog"

Or no name like in the RSS pages.
Than you have to count the tables
In the RSS pages the data is stored in the 6th table (in or macro= .WebTables = "6"):

....
    <table border="0" cellpadding="0" cellspacing="0" width="100%">
        <tr>
     <th>
         Contact:
     </th>
     <td>
         Joanne Anderson<br />Coordinator<br />
         Community Health Systems<br />
         
         Franklin, TN 37067
     </td>
     <td rowspan="5">
         
     </td>
        </tr>
        <tr>
     <th>....

For another company besides CHS you have to find the data table in the HTML and adapt the macro with(if the type of page is in the same place in the URL !!):

 select case ARRURL(5)
 case "RSS"
    'code for RSS HTMLs
 case "???"
    'code for ??? HTMLs
...
 end select

If the type of page is not on the same place, you can use:

 if Instr(ActiveCell.Value,"RSS") then
    'code for RSS HTMLs
 elseif Instr(ActiveCell.Value,"RSS") then
    'code for ??? HTMLs
...
 else
    Msgbox"URL not found..."
 end if

or write a second macro.

[sandy armstrong]

Thanks guido, This is soo confusing to me..... Ok in order for me to do this is first thing set up rss feed right? then name the range where i would like other import data to end up. Or how do i go about setting this up each time so i can get these great results. Thanks Guido i wish i had just half of you programming skill because i trully suck!!!!

[sandy armstrong]

Hey Guido!!! thansk for all your help I finally got it to work.your the best!!!!