PDA

View Full Version : VBA Small Weather Forecast Spreadsheet



Inti
06-20-2014, 12:24 PM
Hi all I am a novice VBA programmer trying to learn by fire. This past couple of days i've been preparing this spreadsheet with the help of forums, google search and youtube.

I am getting a series of errors and I am at a loss. In this case I'm getting a runtime error.

To this point i've hit a wall. Here is the code and I've also attached the file for convenience. In the workbook I included a sheet named 'Goal' which is what would be the end result here.

All help and input is appreciated! Thank you all in advance!


Private Sub btnRefresh_Click() btnRefresh.Caption = "Refreshing..."
btnRefresh.Enabled = False

Dim req As New XMLHTTP
Dim Resp As New DOMDocument
Dim FORECASTDATA As Worksheet
Dim Weather As IXMLDOMNode
Dim Col As Long
Dim SiteList As Range
Dim Site As Variant
Dim SiteName As String
Dim NextSitePtr As Long

Set FORECASTDATA = Sheets("Forecast Data")

With Sheets("site list")
Set SiteList = .Range("a1").Resize(.Cells(Rows.Count, "A").End(xlUp).Row, 1)
End With 'site list

Application.ScreenUpdating = False

For Each Site In SiteList
Col = 0

SiteName = Mid(Site.Value, 8, InStr(8, Site.Value, "/") - 8)

req.Open "GET", Site.Value, False
req.send

Resp.LoadXML req.responseText

For Each Weather In Resp.getElementsByTagName("weather")
FORECASTDATA.Cells(2, 1).Resize(4, 1).Value = Range("rowheaders").Value
Col = Col + 1
FORECASTDATA.Range("theDates").Cells(Col, 1).Value = Weather.SelectNodes("time")(0).Text
FORECASTDATA.Range("theTemps").Cells(Col, 2).Value = Weather.SelectNodes("temperature")(0).Text
FORECASTDATA.Range("theLat").Cells(Col, 3).Value = Weather.SelectNodes("latitude")(0).Text
FORECASTDATA.Range("theLon").Cells(Col, 4).Value = Weather.SelectNodes("longitude")(0).Text
Next Weather
Next Site
Application.ScreenUpdating = True
btnRefresh.Caption = "Refresh"
btnRefresh.Enabled = True
End Sub

p45cal
06-20-2014, 05:09 PM
I know nothing of xml but like you, I managed to cobble something together. See attached which contains this (amateur) code:
Private Sub btnRefresh_Click()
btnRefresh.Caption = "Refreshing..."
btnRefresh.Enabled = False

Dim req As New XMLHTTP
Dim Resp As New DOMDocument
Dim FORECASTDATA As Worksheet
Dim Weather As IXMLDOMNode
Dim rw As Long
Dim SiteList As Range
Dim Site As Variant
Dim SiteName As String
Dim NextSitePtr As Long

Set FORECASTDATA = Sheets("Forecast Data")

With Sheets("site list")
Set SiteList = .Range("a1").Resize(.Cells(Rows.Count, "A").End(xlUp).Row, 1)
End With 'site list

Application.ScreenUpdating = False
rw = 0

For Each Site In SiteList

SiteName = Mid(Site.Value, 8, InStr(8, Site.Value, "/") - 8)

req.Open "GET", Site.Value, False
req.send

Resp.LoadXML req.responseText
Set gggg = Resp.getElementsByTagName("temperature")
For Each temperature In gggg
Set Location = temperature.ParentNode
Set myTime = Location.ParentNode
FromDateAndTime = myTime.Attributes.getNamedItem("from").Value
FromDate = DateValue(Replace(Replace(FromDateAndTime, "T", " "), "Z", ""))
FromTime = TimeValue(Replace(Replace(FromDateAndTime, "T", " "), "Z", ""))
' ToDateAndTime = myTime.Attributes.getNamedItem("to").Value
' ToDate = DateValue(Replace(Replace(ToDateAndTime, "T", " "), "Z", ""))
' ToTime = TimeValue(Replace(Replace(ToDateAndTime, "T", " "), "Z", ""))
myTemp = temperature.Attributes.getNamedItem("value").Value
TempUnits = temperature.Attributes.getNamedItem("unit").Value
Latitude = Location.Attributes.getNamedItem("latitude").Value
Longitude = Location.Attributes.getNamedItem("longitude").Value
' FORECASTDATA.Cells(2, 1).Resize(4, 1).Value = Range("rowheaders").Value
rw = rw + 1
FORECASTDATA.Range("theDates").Cells(rw).Value = FromDate
FORECASTDATA.Range("theDates").Cells(rw).Offset(, 1).Value = FromTime
' FORECASTDATA.Range("theDates").Cells(rw).Offset(, 2).Value = ToDate + ToTime
FORECASTDATA.Range("theTemps").Cells(rw).Value = myTemp
FORECASTDATA.Range("theLat").Cells(rw).Value = Latitude
FORECASTDATA.Range("theLon").Cells(rw).Value = Longitude
Next temperature
Next Site
Application.ScreenUpdating = True
btnRefresh.Caption = "Refresh"
btnRefresh.Enabled = True
End Sub

ps. there is no degrees Fahrenheit data at the site. You could put a conversion in.

Inti
06-22-2014, 02:02 PM
p45cal that seemed to have worked great for you! For some reason it's giving me an error. Any idea? It's highlighting:



req.Open "GET", Site.Value, False


In debug.

p45cal
06-22-2014, 04:06 PM
Does this error occur before any data at all is retrieved?
What is the error message?
I did get a problem with the third url in your sample file, but it didn't cause an error.

Inti
06-22-2014, 06:28 PM
Ok so as soon as I hit refresh I get a runtime error '-2147024891 (80070005)': access is denied and on debug it goes to
req.send just after
req.Open "GET", Site.Value, False

p45cal
06-23-2014, 01:20 AM
Well I retried the sample file I attached and it works here still.
2 things:
1. Have you breached the terms (http://api.yr.no/conditions_service.html)?
2. Send/attach a copy of the file you're using, in case there is a small difference. (Private Message me here if you want an address to send it to if the content is sensitive.)

Inti
06-23-2014, 08:59 AM
I can download the file p45cal, but when I hit the refresh button in excel it gives me the mentioned error. For some reason the program started working fine, i've been working on it for some hours now and all of the sudden it gave the same error. I don't know what's going on.

-Edit-

I figured out what was wrong! Thank you once again p45cal! Can I contact you if I have any other questions? All that I need to do now is to add a way for the user to input a custom name to the latitude/longitude so it's easier to classify. I think I'll do it with a user form. What do you think?

p45cal
06-23-2014, 09:14 AM
The only issue is that if I add a third website and then delete it the previous information does not get deleted. Is there a way to fix this?
Add the following line directly after Application.ScreenUpdating = False

FORECASTDATA.UsedRange.Offset(1).Resize(FORECASTDATA.UsedRange.Rows.Count - 1).ClearContentsThis will clear ALL data from that sheet (not the headers).






For some reason the program started working fine, i've been working on it for some hours now and all of the sudden it gave the same error. I don't know what's going on.I can only re-iterate msg#6

Inti
06-23-2014, 10:01 AM
The error was because I had deleted a range in the spreadsheet. It's working now! Thanks!

p45cal
06-23-2014, 12:10 PM
Can I contact you if I have any other questions?The way to do it is to post a new thread in the public part in the forum as you have done, then if you want, you can PM me that you have posted, but it won't guarantee a response.


All that I need to do now is to add a way for the user to input a custom name to the latitude/longitude so it's easier to classify. I think I'll do it with a user form. What do you think?A userform is often a good idea, especially if you have users who are not confident with spreadsheets. If it's just you, then maybe a userform-less approach is all you need.

Inti
06-23-2014, 12:45 PM
Allright, thanks p45cal, appreciate your help and input! The people that will be working with this are usually around spreadsheets all the time but the faster we can get the job done the better. So maybe using a userform will simplify things. I'll have to think about the layout to make it as simple as possible.

p45cal
12-17-2015, 02:00 AM
there's an area here for testing:
http://www.vbaexpress.com/forum/forumdisplay.php?68-Testing-Area