Selecting adjacent cell

[burl_rfc]

I need help on the code below.

The code works great but I'd like a further enhancement but I'm not
sure what to do.

The macro selects the range of data that falls on the same day, then
for that day it then performs some statistical calculations and places
the results into columns 8 thru 15, the date is also placed into
column 7. It then goes to the next date and continues until all the
datas have been analyized.

What I'd like to do for the maxium and minimum temperature and
humidity readings, is place the actual time when they occured into
column 16 thru 19. The temp data starts at cell c3 and humidity starts
at cell d3, the date field starts at cell b3. The date field is
currently formatted as m/d/yyyy h:mn

I was thinking that sometype of cell offset might do the trick.

Cells(rowd, 16) =
Application.WorksheetFunction.Max(myRange1).cell.offset(0,-1) ' Temp
Max Time

Any help would be appreciated.

burl_rfc

Sub TempStatsDate()

Cells(1, 7) = "Date"
Cells(1, 8) = "Avg Temp"
Cells(1, 9) = "Max Temp"
Cells(1, 10) = "Min Temp"
Cells(1, 11) = "Med Temp"
Cells(1, 12) = "Avg Humidity"
Cells(1, 13) = "Max Humidity"
Cells(1, 14) = "Min Humidity"
Cells(1, 15) = "Med Humidity"
Cells(1,16) = "Temp Max Time

Row = 3
rowi = Row
rowf = Row
rowd = 2

Startdate = Cells(3, 2)
Stopdate = Startdate + 1


5 If Startdate <= Stopdate Then
Startdate = Cells(rowi, 2)
rowi = rowi + 1
rowf = rowf + 1
GoTo 5
End If


'Performes statistics on each group and summarizes information in new
location.

myRange1 = Worksheets("Sheet1").Range(Cells(rowi, 3), Cells(rowf, 3))
' Temperature column
myRange2 = Worksheets("Sheet1").Range(Cells(rowi, 4), Cells(rowf, 4))
' Humidity column
myRange3 = Worksheets("Sheet1").Range(Cells(rowi, 2), Cells(rowf, 2))
' Date column

Cells(rowd, 7) = Startdate
Cells(rowd, 8) = Application.WorksheetFunction.Average(myRange1) '
Temp avg
Cells(rowd, 9) = Application.WorksheetFunction.Max(myRange1) ' Temp
max
Cells(rowd, 10) = Application.WorksheetFunction.Min(myRange1) ' Temp
min
Cells(rowd, 11) = Application.WorksheetFunction.Median(myRange1) '
Temp med

Cells(rowd, 12) = Application.WorksheetFunction.Average(myRange2) '
Hum avg
Cells(rowd, 13) = Application.WorksheetFunction.Max(myRange2) ' Hum
max
Cells(rowd, 14) = Application.WorksheetFunction.Min(myRange2) ' Hum
min
Cells(rowd, 15) = Application.WorksheetFunction.Median(myRange2) ' Hum
med

rowd = rowd + 1
Startdate = Stopdate
Stopdate = Stopdate + 1

GoTo 5

10 End Sub

 

[Tom Ogilvy]

Cells(rowd, 16) =
Application.Index(MyRange3,Application.Match(Application.Max(myRange1),MyRange1,0),1) ' Temp
Cells(rowd,16).Numberformat = "m/d/yyyy h:mm"

 

[JE McGimpsey]

I might do it like this:

This assumes Sheet1 contains the data and Sheet2 is the place to store
the results.

Public Sub TempStatsDate()
Dim vHeadings As Variant
Dim vResult As Variant
Dim rData As Range
Dim rDest As Range
Dim dStopDate As Double
Dim nNumCols As Long
Dim nStartRow As Long
Dim i As Long

vHeadings = Array("Date", "Avg Temp", "Max Temp", _
"Min Temp", "Med Temp", _
"Avg Humidity", "Max Humidity", _
"Min Humidity", "Med Humidity", _
"Temp Max Time")
nNumCols = UBound(vHeadings) - LBound(vHeadings) + 1

With Sheets("Sheet2").Cells(1, 7)
.Resize(1, nNumCols).Value = vHeadings
Set rDest = .Offset(1, 0)
End With

With Sheets("Sheet1")
nStartRow = 3
dStopDate = .Cells(nStartRow, 2).Value + 1
For i = nStartRow + 1 To .Cells(.Rows.Count, 2).End(xlUp).Row
If .Cells(i, 2).Value >= dStopDate Then
Set rData = .Range(.Cells(nStartRow, 2), _
.Cells(i - 1, 4))
If CalcStats(rData, vResult) = False Then Exit Sub
rDest.Resize(1, nNumCols).Value = vResult
Set rDest = rDest.Offset(1, 0)
nStartRow = i
dStopDate = .Cells(i, 2).Value + 1
End If
Next i
Set rData = .Range(.Cells(nStartRow, 2), .Cells(i - 1, 4))
If CalcStats(rData, vResult) = False Then Exit Sub
rDest.Resize(1, nNumCols).Value = vResult
End With
End Sub

Public Function CalcStats(ByRef rData As Range, _
ByRef vResult As Variant) As Boolean
On Error GoTo ErrHandler
CalcStats = True
With Application.WorksheetFunction
vResult = Array( _
rData.Cells(1).Text, _
.Average(rData.Columns(2)), _
.Max(rData.Columns(2)), _
.Min(rData.Columns(2)), _
.Median(rData.Columns(2)), _
.Average(rData.Columns(3)), _
.Max(rData.Columns(3)), _
.Min(rData.Columns(3)), _
.Median(rData.Columns(3)), _
"Error")
vResult(UBound(vResult)) = .Index( _
rData.Columns(1), .Match( _
vResult(LBound(vResult) + 2), _
rData.Columns(2), False))
End With
Exit Function
ErrHandler:
CalcStats = False
End Function