Looping Marco thur url

[sandy armstrong]

Hey Guido for all the other one that i set up are working just perfect but this one is mal funcution do you think it the code or the web that is making it do this? I attached a copy of this file

[Guido Geurs]

On the second line there is an URL (http://www.practicelink.com/jobs/270...logy/KY/King's Daughters Medical Center/)
with 3 columns !
You are capturing data outside the named range!
The old range with 2 columns is not cleaned properly (still data in the 3th column), so the named range is moved => error.
solution: dimension the named range with 3 columns like:
=$O$10:$Q$25
You can also use 3 columns for the others.

[sandy armstrong]

Hey Guido... I have a question If i need this automactially happen everytime I press refresh or refresh happens everytime i open the excel sheet and update the sheet with the new Rss feed that just entered could the code you wrote just start automaticallty but from the row that does not contain and data instead of from the top... Thanks for you help always.....

[sandy armstrong]

I have change the code just a little to catch another pieace of data of that same site it is working up until it needs to paste into excel. I would appreciate the help...
I have attached a file.

[Guido Geurs]

This table is not table "6" but table "5" in the URL (starts at line 1400) so in reading the URL the code must be:

...
        .WebFormatting = xlWebFormattingNone
        .WebTables = "5"
        .WebPreFormattedTextToColumns = True
...

Also you can't use the same structure to dump the data in the sheet.
The table structure is=
=============== =============== ==============
Hospital Employed Psychiatry Opportunity

Kings Daughters Medical Center

King's Daughters Medical Center
Ashland , KY 41101
600,000 service area , 2201 Lexington Avenue

Job ID: 266822
Accepts J1s: No
Loan Assistance: Yes
Practice Type: Hospital Employee
Apply Now EmailFacebookTw itterShareThisS hareThis
=============== =============== ==============

Also: the contents of the first column is not " trFacility:", " Job ID:", ... with space at beginning !!! but "Job ID: "

If you want the data of column1 for the first 8 rows, you just have to read them and dump in the sheet.

PS: for safer reasons I have placed the "URLdata" range to "AA1:AB20"

[sandy armstrong]

Thats why your an expert and im not!!!! thanks for this im really thankful. I followed the steps of what you have told me in the past posts but My biggest problem was getting the data to display after it came over and wanted it to display the name of the hospital and the address also, Thanks again guido for the help. I am so close thanks to you...

[Guido Geurs]

Is this the data in the 1st column on the 5th row?
If so, see attached demo: just set the data from the named range in the offset cell with:

            .Offset(0, 6).Value = Range("URLdata").Cells(5, 1).Value

PS: I have also done some modifications on the definition and clearing of the named range.

[sandy armstrong]

Hey Guido thanks for getting back to me... I dont know what it is it not getting the hospital name for me
----------------------------------------
----------------------------------------
Hospital Employed Psychiatry Opportunity

Kings Daughters Medical Center

King's Daughters Medical Center
Ashland , KY 41101
600,000 service area , 2201 Lexington Avenue

Job ID: 266822
Accepts J1s: No
Loan Assistance: Yes
Practice Type: Hospital Employee
Apply Now EmailFacebookTw itterShareThisS hareThis
-------------------------------------------------
-------------------------------------------------

I would like the 4th and the 5th line of data I tried eveything you told me to do before I looked at the source of the web page and nothing seems to be working for me...

[Guido Geurs]

!! the 4th line is blanc !!!
Must it not be the 3th ??? (see attachment)
----------------------------------------
----------------------------------------
[1]Hospital Employed Psychiatry Opportunity
[2]
[3]Kings Daughters Medical Center
[4]
[5]King's Daughters Medical Center
[6]Ashland , KY 41101
[7]600,000 service area , 2201 Lexington Avenue
....
-------------------------------------------------
-------------------------------------------------

[sandy armstrong]

Thanks Guido Im learning so much from you... I Realize that I said Line 4 from the Example but what i meant was really line 5 and 6 from the data shown above thanks for making it clear to me. I was able fix it with some teaking and tuning and i was proud of myself that i with your help (As Always) i was able to tune it. Now i would like to move it over from the columns that it is being ported into now into another column after column Z. Thanks so much for always getting Back... Guido (!!!!Apperiacte d!!!!!)

[Guido Geurs]

To copy a column fast, use arrays like:( to copy col M to Z)
(M1 is title)

Sub macro_copy_Col()
Dim ARRAYDATA As Variant
    ARRAYDATA = Range("M2").Resize(Range("M2").End(xlDown).Row, 1)
    Range("Z2").Resize(UBound(ARRAYDATA, 1), 1) = ARRAYDATA
End Sub

[sandy armstrong]

Thanks Guido, I finally completed this task all thanks to you!!!!

[Guido Geurs]

This is working for CHS contracts (no row jump)

Sub Capturedata()
'§ Keyboard Shortcut: Ctrl+Shift+L
Dim ARRURL() As String '§ for splitting the URL
Dim QT As QueryTable '§ QueryTables in sheet
Dim URLDATArow As Integer
Dim URLDATAitem As String
Dim URLDATAdata As String
Dim URLDATAitemline 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("URLdata"))
                '§ 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
        End With
        '§ clear QueryTables
        For Each QT In ActiveSheet.QueryTables
            QT.Delete
        Next
        '§ 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, 15).Value = URLDATAdata
                        Case 2
                            .Offset(0, 16).Value = URLDATAdata
                        Case 3
                            .Offset(0, 17).Value = URLDATAdata
                        Case 4
                            .Offset(0, 18).Value = URLDATAdata
                        End Select
                    'Case "Type of Recruiter:"
                   ' Select Case URLDATAitemline
                       ' Case 1
                      '  .Offset(0, 18).Value = URLDATAdata
                     '  End Select
                    Case "Phone:"
                        Select Case URLDATAitemline
                        Case 1
                            .Offset(0, 19).Value = URLDATAdata
                        Case 2
                            .Offset(0, 20).Value = URLDATAdata
                        End Select
                    Case "Fax:"
                      .Offset(0, 21).Value = URLDATAdata
                                       
                    End Select
                End If
            Next
            '§ go 1 cell down
            .Offset(1, 0).Activate
        End With
        ActiveSheet.Range("URLdata").Clear
    Loop
'    Call Macro1
 End Sub

[sandy armstrong]

Thanks Guido I am Able to do this for every Rss feed I bring in from this site with a little modification I am Very happy with this Thanks so much for helping me with this Again again again Thanks Soooo much!!! Your the Best!!

[sandy armstrong]

Hey Guido Just a thought... Can these to code be combined in order to perform this action together. right now what i do is run one macro then call up the other when that one finishes... I was just thinking it would make it easier. Right now as we speak i am running the first marco on 11,000 and if works great the after that it runs the second part. it takes a whole 24 hours to complete the task fully. Thanks