View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Jason Jason is offline
external usenet poster
 
Posts: 367
Default Generate web address string from date range in column?

Tim,

Your sub helped me to determine what I needed to adjust on ours to read the
cells necessary and now I am almost there.

The one last thing that is stumping me is when I use the following line:
dt = Format(c.Value2, "yyyy/m/d")

It reads the correct day and month but it throws the year off by 98
Example:
If the date is 2008/8/20 it uses 1910/8/20 instead
If the date is 2009/6/24 it uses 1911/6/24 instead

I have pasted the entire sub for background

Sub getCityTemps()
Dim AirCode As Range, ACrng As Range
Dim c As Range, rng As Range
Dim dt As String
Dim dt_Year As Long, dt_Month As Long, dt_Day As Long
Dim dtBefore As String
Dim dtBefore_Year As Long, dtBefore_Month As Long, dtBefore_Day As Long
Dim i As Long
Dim sURLairport As String
Dim myStr As String
Dim test As Variant
Dim Val As Variant
Dim IE As Object

Dim RngDates As Range
Set RngDates = Range("A4")
RngDates.DataSeries Rowcol:=xlColumns, Type:=xlChronological, Date:=xlDay,
Step:=1, Stop:=Date, Trend:=False

Dim StartRow As Long
Const FirstValidRow As Long = 4

Set rng = Range("A2").CurrentRegion

Set rng = rng.Resize(rowsize:=rng.Rows.Count - FirstValidRow + rng.Row)
Set rng = rng.Offset(rowoffset:=FirstValidRow - rng.Row)
'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:=rn g.Rows.Count -
StartRow, columnsize:=1)

'If c.Value < "" And Len(c.Offset(0, 1).Value) = 0 Then

'For Each c In rng
'sURLdate = Format(c.Value2, "yyyy/m/d")

c = StartRow + 1
'dt = CDate(StartRow)
dt = Format(c.Value2, "yyyy/m/d")
dtBefore = Date - 1

'dt_Year = Year(dt)
'dt_Month = Month(dt)
'dt_Day = Day(dt)

dtBefore_Year = Year(dtBefore)
dtBefore_Month = Month(dtBefore)
dtBefore_Day = Day(dtBefore)

'End If

'Const sURL2 As String =
"/2008/9/1/CustomHistory.html?dayend=7&monthend=7&yearend=200 9&req_city=NA&req_state=NA&req_statename=NA"
Const sURL2 As String = "/"
Const sURL3 As String = "/CustomHistory.html?dayend="
Const sURL4 As String = "&monthend="
Const sURL5 As String = "&yearend="
Const sURL6 As String = "&req_city=NA&req_state=NA&req_statename=NA"


Set ACrng = Sheets("City_Airport").Range("B2:B26")
For Each AirCode In ACrng
Const sURL1 As String = _
"http://www.wunderground.com/history/airport/K"
sURLairport = AirCode

'STEP 3 - Change the dates here in sURL2 to reflect the range you are
trying to find data for
'STEP 4 - RUN Macro




Dim sURLdate As String

Application.Cursor = xlWait
Set IE = CreateObject("InternetExplorer.Application")

IE.Navigate sURL1 & sURLairport & sURL2 & dt & sURL3 & dtBefore_Day & sURL4
& dtBefore_Month & sURL5 & dtBefore_Year & sURL6
'IE.Navigate sURL1 & sURLairport & sURL2 & dt_Year & sURL2 & dt_Month &
sURL2 & dt_Day & sURL3 & dtBefore_Day & sURL4 & dtBefore_Month & sURL5 &
dtBefore_Year & sURL6
'IE.Navigate sURL1 & sURLairport & sURL2 & dt & sURL3 & dtBefore_Day & sURL4
& dtBefore_Month & sURL5 & dtBefore_Year & sURL6

While IE.ReadyState < 4
DoEvents
Wend
myStr = IE.Document.body.innerhtml


For Each c In rng
sURLdate = Format(c.Value2, "yyyy/m/d")
c.Offset(0, i + 1).Value = RegexMid(myStr, sURLdate, "bl gb")
c.Offset(0, i + 2).Value = RegexMid(myStr, sURLdate, "br gb")
c.Offset(0, i + 3).Value = RegexMid(myStr, sURLdate, "class=gb")
Next c
IE.Quit
Set IE = Nothing

i = i + 3

Next AirCode

Application.Cursor = xlDefault
End Sub
Private Function RegexMid(s As String, sDate As String, sTempType As String) _
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" & sDate & "/DailyHistory[\s\S]+?" & sTempType _
& "\D+(\d+)"

If re.test(s) = True Then
Set mc = re.Execute(s)
RegexMid = mc(0).submatches(0)
End If
Set re = Nothing
End Function