Hello there.
I am attempting to write a macro which formats my data correctly before it is uploaded into a database.
My data is held on two worksheets, one named 'July' and one named 'Weather.
In July I have a list of dates and times a certain area has been visited, then spaces for the associated weather data.
In Weather, I have a list of dates, time in half hourly intervals and the associated wind speed and direction.
What I am attempting to do is to match the date in July with the date in Weather, then match the times as best as possible. The times in July are rarely on the hour or the half hour, so they have to be matched to the nearest time. For example, 7.45 in the July sheet would pick up the data from 7.30 in the weather sheet because it is between 7.30 and 8.00.
Having matched the appropriate date and time, the associated weather data is populated in the July sheet.
I seem to have got most of the macro to work, but it doesn't seem to be copying across the appropriate weather data for the time! I've annotated it as much as I can, but any help you can offer would be greatly appreciated.
I've also attached a sample of my data. The actual data runs to over 10000 rows!
Thank you in advance.
AL
Sub ReturnWeather()
'Macro to find data for the correct date and associate time (or near time)
'and return the wind speed and direction
'********************************************************************************
'* Need to add a message box to determine the correct Month's tab. *
'* *
'* *
'* Check that the correct weather data is being pulled across *
'* - don't think that it is! *
'********************************************************************************
Dim MonDate As Range 'Monitoring Date
Dim MonTime As Range 'Monitoring Time
Dim MonWSpeed As Range
Dim MonWDir As Range
Dim MonWDirNr As Range
Dim wDate As Range 'Weather Date
Dim wTime As Range 'Weather Time
Dim wSpeed As Range 'Wind speed
Dim wDir As Range 'Wind direction
Dim wDirNr As Range 'Associated Wind direction number
Dim wRange As Range 'temp place for search for next date in Weather
Dim rCount As Integer 'count of number of rows used
Dim tDate As String 'temp place to hold next date
Set MonDate = Sheets("July").Range("B2") ' set the various ranges to the current sheet. Need to amend for user input
Set MonTime = Sheets("July").Range("C2")
Set MonWSpeed = Sheets("July").Range("I2")
Set MonWDir = Sheets("July").Range("J2")
Set MonWDirNr = Sheets("July").Range("k2")
Set wSpeed = Sheets("Weather").Range("C2") ' set the weather defaults.
Set wDir = Sheets("Weather").Range("D2")
Set wDirNr = Sheets("Weather").Range("E2")
Set wDate = Sheets("Weather").Range("A2")
Set wTime = Sheets("Weather").Range("B2")
Do While Not IsEmpty(MonDate) 'while column monitoring date is empty (on current month)
Worksheets("July").Activate 're-activate the month worksheet
MonDate = Format(MonDate, "Short Date") 'format the dates to short date
wDate = Format(wDate, "Short Date")
Do While MonDate = wDate 'whilst the monitoring date is equal to the weather date, do the following
Do While IsEmpty(MonWSpeed) 'whilst wind speed on the monthly spreadsheet is empty do this
If MonTime >= wTime And MonTime < wTime + 0.0208 Then 'if the monitoring time is between the hour and the half hour on the weather sheet, do this. e.g. between 7 and 7.30
MonWSpeed = wTime.Offset(0, 1) 'fill in the monitoring data relative to the time
MonWDir = wTime.Offset(0, 2) 'so it should copy across the correct data for 7am when the
MonWDirNr = wTime.Offset(0, 3) 'monitoring time is 7.45
End If
Set wTime = wTime.Offset(1, 0) 'set the weather time to the next one down
' Range("p67") = wTime 'ignore this - it's just for testing purposes
' Range("P68") = MonTime
Loop
Set MonDate = MonDate.Offset(1, 0) 'set all the monthly data to the next one down
Set MonWSpeed = MonWSpeed.Offset(1, 0) 'this should now be empty
Set MonWDir = MonWDir.Offset(1, 0)
Set MonWDirNr = MonWDirNr.Offset(1, 0)
Set MonTime = MonTime.Offset(1, 0)
Set wTime = wDate.Offset(0, 1) 'sets the time relative to the date. Not sure if this is working!
'
' Range("p3") = wTime
' Range("q3") = wDate
MonDate = Format(MonDate, "Short Date") 'again, re-sets the dates to the right format
wDate = Format(wDate, "Short Date")
Loop
If IsEmpty(MonDate) Then 'if monitoring (monthly) date is empty, then end the macro because end of dataset.
Exit Sub
End If
Worksheets("Weather").Activate 'activate the weather worksheet
Set wRange = Cells.Find(What:=CDate(MonDate), After:=Range("A1")) 'find the next monitoring date. DOES NOT SEEM TO FIND THE FIRST INSTANCE!
' wRange.Select
Set wDate = wRange 'Set the weather date to match the result of the search
wTime = wDate.Offset(0, 1) 'set the weather time to the first time associated with the new date
Loop
End Sub
Display More
