View Single Post
  #16   Report Post  
Posted to microsoft.public.excel.programming
Rick Rothstein Rick Rothstein is offline
external usenet poster
 
Posts: 5,934
Default Loop through date range, but skip down to next year


Works too good, eh?<g Okay, how about this "not too good" code then?<bg

' Place the following Dim statement in the (General)(Declarations)
' section at the top of whatever module you put the macro in.
Dim TableValues() As String

Sub DistributeYearData()
Dim IE As Object
Dim X As Long
Dim Z As Long
Dim Yr As Long
Dim CellVal As Variant
Dim myStr As String
Dim MonthData() As String
Dim YearParts() As String
Const sURL1 As String =
"http://tonto.eia.doe.gov/dnav/ng/hist/n9132cn2m.htm"
On Error Resume Next
X = UBound(TableValues)
If Err.Number Then
On Error GoTo 0
Err.Clear
Set IE = CreateObject("InternetExplorer.Application")
IE.Navigate sURL1
While IE.ReadyState < 4
DoEvents
Wend
myStr = IE.Document.body.innerhtml
IE.Quit
Set IE = Nothing
YearParts = Split(myStr, "<td class=B4&nbsp;&nbsp;", , vbTextCompare)
ReDim TableValues(12 * (1 + (Val(YearParts(UBound( _
YearParts))) - Val(YearParts(1)))))
For X = 0 To UBound(YearParts) - 1
Yr = Val(YearParts(X + 1))
MonthData = Split(YearParts(X + 1), "<td class=B3", , vbTextCompare)
For Z = 1 To 12
TableValues(12 * X + Z - 1) = Yr & Format$(Z, "00") & "01-" & _
Val(Replace(MonthData(Z), ",", ""))
Next
Next
End If
For X = 2 To Cells(Rows.Count, "A").End(xlUp).Row
CellVal = Cells(X, "A").Value
If CellVal < "" Then
Cells(X, "B").Value = Mid(Filter(TableValues, Format$( _
CellVal, "yyyymm01-"))(0), 10)
End If
Next
End Sub

NOTE: Since you said you were going to run multiple scenarios, I figured
there was no reason to go out to the website and download and reprocess the
same data over and over again; so I made the TableValues array "global" by
placing it in the (General)(Declarations) section (outside of any
procedures) of the module you place the code in. Doing this will make your
second and all other scenario runs execute at a blindly fast pace (well,
blindingly fast as compared to the first run which has to open the website,
read the data and then process the data to create the TableValues array).
There is one *possible* downside to doing this, however... if you leave the
worksheet module that the array and code are in open, and the data changes
on the website for some reason, the TableValues array will not have the
updated values in it. Here is a routine you can place in the same module as
the above code...

Sub ClearTableValuesArray()
Erase TableValues
End Sub

Run it and it will clear the TableValues array so that the next time you run
my DistributeYearData macro, it will be forced to go out and refresh the
TableValues array with the latest data. Of course, shutting Excel down will
also clear the TableValues arrays as well; so if you close the workbook
daily, that will accomplish the same thing.

--
Rick (MVP - Excel)


"Jason" wrote in message
...
Works great!

My only issue it actually works better than I need. I would prefer it to
read the dates from the column...that way I can enter the dates in and run
variations of this routine to fill in similar stats in the other columns