Generate web address string from date range in column?

J

Jason

We have a spreadsheets that has dates Column A and the data from websites in
remaining columns

We need to be able to change the following web address to correspond to our
desire date range
http://www.wunderground.com/history...009&req_city=NA&req_state=NA&req_statename=NA

In this particular instance, the date range is May 3, 2009 - July 8, 2009 as
you can tell from the dates in the address

We would like to be able to read the date of the first row without data in
the columns other than A as well the date of the "yesterday" (meaning the
previous day) .

To use the date range from the above address as an example. The spreadsheet
has data up until May 2, 2009.

1. so the rows for May 3, 2009 on down are blank (except for the date in
column A) and becomes the first part of our desired range

2. The "yesterday" part comes from the fact that the data for today is not
complete, so if we ran it today, we would want the second part of the range
to be July 8, 2009.

3. If the next time we ran it was August 18, 2009 then that range
would....yep...July 9, 2009 - August 17, 2009

Hopefully that explains our need, but feel free to ask any more questions.

Any solutions would are greatly appreciated.
 
T

Tim Williams

Convert all of your URL's into "templates"

Eg:

www.wunderground.com/history/airport/KLAX/<ystart>/<mstart>/<dstart>/CustomHistory.html?dayend=<dend>&monthend=<mend>&yearend=<yend>&req_city=NA&req_state=NA&req_statename=NA

Create a function to take two dates and your template and return the correct
URL

Function GetQueryURL(byval sTemplate as string, dStart as Date, dEnd as
Date) as String
dim rv as string
rv=replace(sTemplate,"<dstart>", DatePart("d", dStart) );
rv=replace(rv,"<mstart>", DatePart("m", dStart) )
'....etc

GetQueryURL = rv
End Function

etc etc

If there are specific other parts you're having problems with, post back.

Tim
 
J

Jason

Tim,

Thanks, I am still learning and so can use the tips on strings, but am more
in need of how to read the 2 dates I need from the cells in column A that
will makeup the string.

The first date is the first row that just has a date in column A and then no
data in the other columns on that row.

The ending date in the row is "yesterday"...meaning that it will be the one
day before whatever day the script is run...since the date from the website
is updated at the end of each day.

The original post has a little more explanation or you can ask me any
questions if it is not clear.

Thanks again!
 
T

Tim Williams

I'm not clear on your date requirements, despite your initial
explanation.

However, to find the first date with no data

dim c as range
for each c in thisworkbook.sheets("WebData").range("A2:A1000")


next c
 
T

Tim Williams

Option Explicit

Sub Tester()

Dim c As Range, dt As Date, dtBefore As Date

For Each c In ThisWorkbook.Sheets("WebData").Range("A2:A1000")
If c.Value <> "" And Len(c.Offset(0, 1).Value) = 0 Then

dt = CDate(c.Value) 'this is the first "no data" date
dtBefore = dt - 1 'day before

Debug.Print dt, dtBefore 'do something with these dates

Exit For ' ?not clear if you need to stop after the first
one...
End If
Next c

End Sub

Tim
 
J

Jason

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:=rng.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=2009&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
 
T

Tim Williams

Why are you using value2 and not value ?
How are your source cells formatted and exactly what are you entering ?

Tim


Jason said:
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:=rng.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=2009&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
Click to expand...
 
J

Jason

Tim,

I think the value2 was a remnant of the code I was modifying. I changed it
to value and it gave the same result.

The source cells are date format cells in column A in m/d/yyyy format
 
T

Tim Williams

Are you positive that c has the value you expect ?

This:
c = StartRow + 1

Will overwrite the date with whatever StartRow + 1 is.

Tim
 
J

Jason

Tim,

You are right. It is reading the row # not the value in column A of that
row. I just need to determine how to get the value from the cell in column A
of that particular row.

Jason
 
J

Jason

Okay, got that done with
dt = Format(Cells(c.Row, 1), "yyyy/m/d")

Now just cleaning up the code to make it run faster.

Thanks for all your help!
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Why won't negative sign come over with negative numbers? 1
Script only pulls numbers not minus sign for negatives? 0
VBA and Scheduled task in Outlook 1
Formula based on variable range 3
Find string from column A in Range("B2:F7") list the header of that column/s 5
Copy row info but not in normal column sequence 6
Date range in x axis 1
Date Range Query. Criteria based in a table. 4

Top