Copy value on a monthly basis from a website and update excel workbook

[pyrte]

Hi guys,

I tried to record a macro but that does not seem to be working for this sort of requirement.

I'm in need to extract backlink information on a monthly basis from ahrefs.com

Right now I manually extract that information on a monthly basis and I have over 100 blogs that I need to pull the metrics from.

here is an example destination URL of a blog that I'm tracking problogger.net

https://ahrefs.com/site-explorer/ove...problogger.net

The information I need is stored under "Backlinks"

In actuality, I need the whole row of items, But I think I will be able to come up with a workable option if I get one item figured out. If anyone can help it would be awesome.

How my excel workbook looks like, see attached. Any and all help is appreciated.
Blog Tracker.xlsx

[offthelip]

The web page you give a link to displays all the data as Images, not as html or any other sort of data. This is going to make it virtually impossible to extract the data into an excel spreadsheet.
I say virtually because I suppose it would be possible to extract the images , pass the images through some character recognition software, then parse the characters to find the data that you are looking, even then it would be very very difficult and unreliable .

[pyrte]

The web page you give a link to displays all the data as Images, not as html or any other sort of data. This is going to make it virtually impossible to extract the data into an excel spreadsheet.
I say virtually because I suppose it would be possible to extract the images , pass the images through some character recognition software, then parse the characters to find the data that you are looking, even then it would be very very difficult and unreliable .

My apologies for not making it clear. You need a login to be able to access the page. I have a premium account. But for the purpose of this macro, you can set up a 14 day trial account, if need be I can set up an account for you. The data displayed is not as images. I believe you are taken to the page where they are showing you a screenshot of what you will see on the inside when you login.

[offthelip]

I don't have time to so your specific development but I can show you how I have done something similar: the following code downloads the current list of FTSE100 companies from the London Stock Exchange webiste by web scraping with web queries which is probably the easiest but not the fastest way of doing this:

[vba]Sub Getftse100list()
' On Error Resume Next
Sheets("FTSE100").Select
endarr = 1
Range(Cells(1, 1), Cells(280, 3000)) = ""
On Error GoTo ErrHandler:
errorcnt = 0
index = 0

Dim WSD As Worksheet
Dim WSW As Worksheet
Dim QT As QueryTable
Dim indata As Variant




initstring = "URL;http://www.londonstockexchange.com/exchange/prices-and-markets/stocks/indices/summary/summary-indices-constituents.html?index=UKX&page="




Sheets("down").Select
Range(Cells(1, 1), Cells(200, 200)) = ""




'***************************************88888
For i = 1 To 6 Step 1


fullstring = initstring & i


Sheets("down").Select
ConnectString = fullstring
' On the Workspace worksheet, clear all existing query tables
For Each QT In ActiveSheet.QueryTables
QT.Delete
Next QT

' Define a new Web Query
Set QT = ActiveSheet.QueryTables.Add(Connection:=ConnectString, Destination:=Range("A1"))
With QT
.Name = MyName
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingAll
.WebTables = "1"
.WebPreFormattedTextToColumns = True
' .WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
End With

' Refresh the Query
QT.Refresh BackgroundQuery:=False

Sheets("down").Select
indata = Range(Cells(1, 1), Cells(50, 2))
For j = 3 To 50
If indata(j, 1) = "" Then
lastrow = j - 1
Exit For
End If
Next j
Sheets("FTSE100").Select
Range(Cells(endarr, 1), Cells(endarr + 50, 2)) = indata
endarr = endarr + lastrow
Sheets("down").Select



Label1:
Next i
'Cells(1, 4) = "complete"
Exit Sub
ErrHandler:
temperr = Err.Number
tempd = Err.Description
tempc = Err.HelpContext
tempc = Err.LastDllError
temf = Err.Source


' go back to the line at Label1:
Resume Label1:
END SUB
[/vba]

[pyrte]

Thanks offthelip


I will play around to see if I can make this work for me. Appreciate the help.