CODEWITHSUNDEEP
vbaexcelmacros
Mayur Alaspure
Mayur Alaspure

Reputation: 69

VBA to find text from webpages

I have created Macro which gives me all URLs present on any webpages. We just need to provide the URL and it gives us the all links present in that webpage and paste it in one column

Private Sub CommandButton4_Click()

'We refer to an active copy of Internet Explorer
Dim ie As InternetExplorer
'code to refer to the HTML document returned
Dim html As HTMLDocument
Dim ElementCol As Object
Dim Link As Object
Dim erow As Long
Application.ScreenUpdating = False
'open Internet Explorer and go to website
Set ie = New InternetExplorer
ie.Visible = True
ie.navigate Cells(1, 1)

'Wait until IE is done loading page
Do While ie.READYSTATE <> READYSTATE_COMPLETE

Application.StatusBar = "Trying to go to website…"
DoEvents
Loop

Set html = ie.document
'Display text of HTML document returned in a cell
'Range("A1") = html.DocumentElement.innerHTML
Set ElementCol = html.getElementsByTagName("a")

For Each Link In ElementCol
erow = Worksheets("Sheet4").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Cells(erow, 1).Value = Link
Cells(erow, 1).Columns.AutoFit
Next

'close down IE, reset status bar & turn on screenupdating

'Set ie = Nothing
Application.StatusBar = ""
Application.ScreenUpdating = True
ie.Quit
ActiveSheet.Range("$A$1:$A$2752").removeDuplicates Columns:=1, Header:=xlNo

End Sub

Now can anyone will help me to create macro to find particular text from all these URLs present in column and if that text is present then in next column it should print text "text found".

Example if we search text "New" then it should print text "Text found" in next column of the URL.

Thank you.

Upvotes: 2

Views: 2611

Answers (2)

m e
m e

Reputation: 291

The key would be the function Instr, if it finds the string "New", it returns the position where it begins, otherwise it returns 0.

i=1
do until trim(Cells(i,1).Value) = vbNullString
    if instr(Cells(i,1).Value,"New") then
        Cells(i,2).value="Text found"
    end if
    i=i+1
loop

Upvotes: 1

Clauric
Clauric

Reputation: 1896

Similar to above. 

Dim a As Variant

a = 2

While Cells(a, 1) <> "" And Cells(a + 1, 1) <> ""

    If InStr(Cells(a, 1), "new") = 0 Then

    Else
        Cells(a, 2) = "Text Found"

    End If

    a = a + 1

Wend

Upvotes: 0

Related Questions