Loop through date range, but skip down to next year
I am pulling the data from the HTML source code off the website.
Here is my full code below to help. To replicate the problem I am seeing,
column A with Jan 2000 to say Dec 2004 incrementing by month
Jan 2000
Feb 2000
.....
Running the code will put the value for January total for 2000 in every
month with the year 2000, Janurary total for 2001 in every month for 2001 and
so on. We want to use a program (that works correctly) similar to the one
below, so we can add on later for other countries, etc.
Option Explicit
Sub getExportCanada()
Dim c As Range, rng As Range
Dim myStr As String
Dim test As Variant
Dim Val As Variant
Dim IE As Object
Const sURL1 As String = "http://tonto.eia.doe.gov/dnav/ng/hist/n9132cn2m.htm"
Dim sURLdate As String
Application.Cursor = xlWait
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate sURL1
While IE.ReadyState < 4
DoEvents
Wend
myStr = IE.Document.body.innerhtml
Dim StartRow As Long
Set rng = Range("A2").CurrentRegion
'look for last filled in row
Set c = rng.SpecialCells(xlCellTypeBlanks).Areas(1)
Set c = c.Resize(1, 1)
StartRow = c.Row - rng.Row
Set rng = rng.Offset(rowoffset:=StartRow).Resize( _
rowsize:=rng.Rows.Count - StartRow, columnsize:=1)
For Each c In rng
sURLdate = Format(c.Value2, "yyyy")
c.Offset(0, 1).Value = RegexMid(myStr, sURLdate, "class=b3")
Next c
IE.Quit
Set IE = Nothing
Application.Cursor = xlDefault
End Sub
Private Function RegexMid(s As String, sYear As String, sMonthTotal) As String
Dim re As Object, mc As Object
Set re = CreateObject("vbscript.regexp")
re.IgnoreCase = True
re.MultiLine = True
re.Global = True
re.Pattern = "\b" & "nbsp;" & sYear & "[\s\S]+?" & sMonthTotal & "\D+(\d+)"
' Yes I know the syntax for the line above is wrong, I am working on that as
well
If re.test(s) = True Then
Set mc = re.Execute(s)
RegexMid = mc(0).SubMatches(0)
End If
Set re = Nothing
End Function
|