VBA to find text from webpages - vba

Question

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.

Answer 1

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

Answer 2

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