Hello,
I am still picking on my VBA but not there yet. I am trying to work on a vba code that will open a webpage from a cell in excel scrape into a formatted text and place into a single cell in the same worksheet. The pages i am trying to grab are not the same in structure.
After searching on the web i was able to review codes from other people and put pieces together to work. the problem is that what i have works some what, but the pages that is pulled in excel comes in with the formatting and merge cells are not able to be handled. Also the process is slow when run which keeps my system tied up, making it unable to do other site.
Please see attached code and any help that io can get will be deeply appreciated. thank
code:
1. links are put into E of excel sheet
2. webpage destination is in column P
3. I have a search word in G1 that goes through the data in P and if it exist returns a Yes in column K.
Thank you
I am still picking on my VBA but not there yet. I am trying to work on a vba code that will open a webpage from a cell in excel scrape into a formatted text and place into a single cell in the same worksheet. The pages i am trying to grab are not the same in structure.
After searching on the web i was able to review codes from other people and put pieces together to work. the problem is that what i have works some what, but the pages that is pulled in excel comes in with the formatting and merge cells are not able to be handled. Also the process is slow when run which keeps my system tied up, making it unable to do other site.
Please see attached code and any help that io can get will be deeply appreciated. thank
code:
1. links are put into E of excel sheet
2. webpage destination is in column P
3. I have a search word in G1 that goes through the data in P and if it exist returns a Yes in column K.
Thank you
Code:
Public strsearch As String
Sub SearchSite()
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
For j = Selection.Row To Selection.Row + Selection.Rows.Count - 1
' Get the URL
theurl = Range("E" & j)
If theurl = "" Then GoTo NextRow
' Fill the query table
With ActiveSheet.QueryTables.Add(Connection:="URL;" & theurl, Destination:=Range("P" & j))
.Name = "NewsQuery"
.AdjustColumnWidth = False
.RefreshStyle = xlOverwriteCells
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = False
End With
combineCellsIntoOne Range("P" & j)
' Search the Query Table for the Search Term
strsearch = Range("G1")
bottomrow = Range("P" & Rows.Count).End(xlUp).Row
For i = j To bottomrow
If InStr(Range("P" & i), stresearch) <> 0 Then
Range("K" & j) = "YES"
Exit For
End If
Range("K" & j) = "YES"
Next i
NextRow:
Next j
End Sub
Sub combineCellsIntoOne(dest As Range)
Dim lastRow As Long
lastRow = Cells(Rows.Count, dest.Column).End(xlUp).Row
Dim i As Long
For i = dest.Row + 1 To lastRow
dest.Value = dest.Value & " " & Cells(i, dest.Column).Value
Application.DisplayAlerts = flash
Cells(i, dest.Column).Delete 'Clear ‘Contents
Application.DisplayAlerts = True
Next i
End Sub