Finding Max and Cell Ref it occurs at 1

[djburnheim]

I'm trying to write a procedure that finds a maximum in a Range and then returns it and the value of the cell to the left of it. I can get the maximum no worries and I've been playing around trying to use the find function to get the cell it's in, then the offset property to reference the cell to the left of it but it never seems to find the value (see below). I'm wondering if there is another way I could do it.

***Code***

Dim CommentText As String
dRow = 1
dColumn = 3

'Find Maximum time from Sheets "Temp"
Sheets(1).Cells(dRow + 2, dColumn) = Application.WorksheetFunction.Max(Sheets("Temp&quot.Range(Sheets("Temp&quot.Cells(1, 2), Sheets("Temp&quot.Cells(1000, 2)))

'Format time for find function
Longest = Format(Sheets(1).Cells(dRow + 2, dColumn), "hh:mm:ss&quot

'Search Sheets "Temp" for Longest Time
With Sheets("Temp&quot.Range("B1:B1000&quot
Set mCell = .Find(Longest)
If Not mCell Is Nothing Then
CommentText = Format(mCell.Offset(0, -1), "H:MM:SS AMPM&quot
End If
End With

Any suggestions?

Thanks
Dave

 

[sfvb]

You were pretty close. The parts I changed are in red. I haven't had the occasion to work with dates much, but my guess is that although you may have the date formatted in a certain way, Excel expects the comparison in the same format that it stores it internally, and that's why it didn't work.

Like I said, I haven't worked with dates much. Maybe someone more experienced with dates can give a more thorough explaination.

Sub FindMaxDateTime()
   Dim CommentText   As String
   dRow = 1
   dColumn = 3
   
   'Find Maximum time from Sheets "Temp"
   Sheets(1).Cells(dRow + 2, dColumn) = Application.WorksheetFunction.Max(Sheets("Temp").Range(Sheets("Temp").Cells(1, 2), Sheets("Temp").Cells(1000, 2)))
           
   'Format time for find function
   Longest =

Sheets(1).Cells(dRow + 2, dColumn)

   'Search Sheets "Temp" for Longest Time
   With Sheets("Temp").Range("B1:B1000")
      Set mCell = .Find(Longest)
      If Not mCell Is Nothing Then

mCell.Offset(0, -1) = Format(mCell, "H:MM:SS AMPM")

      End If
   End With
End Sub

 

[Zathras]

The .Find method seems to have trouble when dealing with floating point numbers. (Try it just using the worksheet dialog with shift-F5.)

Here is a different approach using a UDF. Put this in a code module:
[blue]

Option Explicit

Sub Test()
Const SOURCE_DATA = "B3:B1000"
Dim rDestination As Range
  Set rDestination = Range(SOURCE_DATA)

[green]

  ' Copy first cell to set destination format

[/color]

  rDestination.Cells(1, 1).Copy Destination:=[C3]
  [C3] = FindLargest(rDestination)
  [C4] = FindLargest(rDestination, True)
End Sub

Function FindLargest(Ref As Range, Optional FindAddress As Boolean = False)

[green]

' Finds largest number in a range of numbers
' Optionally if parameter2 is True, returns address
'          instead of number

[/color]

Dim c As Range
Dim sAddress As String
Dim nDelta As Double
  FindLargest = WorksheetFunction.Max(Ref)
  If FindAddress Then
    nDelta = 99999
    For Each c In Ref
     If Abs(c - FindLargest) < nDelta Then
       nDelta = Abs(c - FindLargest)
       sAddress = c.Address
     End If
    Next c
    FindLargest = sAddress
  End If
End Function

[/color]
Put your times in B3:B1000 and run the test macro. Alternatively, put functions in the worksheet wherever you want to see the results (format the cells manually):
[blue]

D3: =FindLargest(B2:B1000)
D4: =FindLargest(B2:B1000,TRUE)

[/color]
The first form returns the largest value and the second form provides the address.

 

[djburnheim]

Thanks both for the reply...I previously tried all combinations with the time format but could not get the find function to work so was really hoping for an alternative and Zathras' worked a treat. I had to modify a little...below is my working code. Thanks all for your help

Dave

Dim WaitTime, Query, Team, CommentText As String
Dim TotalWait, RecordCount, WaitHour, WaitMin, WaitSec As Integer
Dim rDestination As Range
Const SOURCE_DATA = "B3:B1000"

CommentText = "No Time Available"

' Turn off screen update & alerts
Application.ScreenUpdating = False
Application.DisplayAlerts = False

' Add Scratch worksheets for max queues
Set NewSheet = Worksheets.Add
NewSheet.Name = "Temp"
Sheets("Temp&quot.Move After:=Sheets(Sheets.Count)
Set rDestination = Sheets("Temp&quot.Range(SOURCE_DATA)
Sheets(1).Activate

' Match date in report sheet with column in Daily Stats
ReportDate = Sheets(1).Cells(1, 1)

With Sheets(1).Range("b1:q40&quot
Set dCell = .Find(ReportDate)
If Not dCell Is Nothing Then
dColumn = dCell.Column
dRow = dCell.Row
End If
End With

' Check for Daylight Saving Time offset
Dim startDST, endDST As Date
Dim DST, DST1stTime, DST2ndTime

startDST = CDate("1/4/" & Year(Date))
Do Until Weekday(startDST) = 1
startDST = startDST - 1
Loop

endDST = CDate("31/10/" & Year(Date))
Do Until Weekday(endDST) = 1
endDST = endDST - 1
Loop

If ReportDate >= startDST And ReportDate <= endDST Then
DST = 0.0417
Else
DST = 0
End If

Team = &quot;Team 1&quot;
For q = 1 to 2

SQL Query to get data to Temp worksheet

' Format Queue time
Dim QueueC As Range
Set QueueC = Sheets(&quot;Temp&quot.Range(&quot;B1:B1000&quot
For Each Cell In QueueC
Cell = Format(Cell, &quot;hh:mm:ss&quot
Next Cell

' Find Max Queue Time
'Zathras' Code
' Copy first cell to set destination format
rDestination.Cells(1, 1).Copy Destination:=Sheets(1).Cells(dRow + 2, dColumn)
Sheets(1).Cells(dRow + 2, dColumn) = FindLargest(rDestination)
CommentText = FindLargest(rDestination, True)

'Add Comment
Sheets(1).Activate
Sheets(1).Cells(dRow + 2, dColumn).Select
Sheets(1).Cells(dRow + 2, dColumn).AddComment
Sheets(1).Cells(dRow + 2, dColumn).Comment.Visible = False
Sheets(1).Cells(dRow + 2, dColumn).Comment.Text Text:=CommentText

' Format Cell
Sheets(1).Activate
Sheets(1).Cells(dRow + 2, dColumn).NumberFormat = &quot;h:mm:ss&quot;
Sheets(1).Cells(dRow + 2, dColumn).Select
With Selection.Interior
.ColorIndex = 36
.Pattern = xlSolid
End With
With Selection
.HorizontalAlignment = xlCenter 'centre align cell
End With
With Selection.Font
.Size = 9
.Bold = True
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

' Clear Temp Sheet
Sheets(&quot;Temp&quot.Activate
Cells.Select
Selection.ClearContents
Selection.QueryTable.Delete
Sheets(1).Activate


Another SQL Query to get 2nd lot of data to Temp worksheet

' Find Max Queue Time
'Zathras' Code
' Copy first cell to set destination format
rDestination.Cells(1, 1).Copy Destination:=Sheets(1).Cells(dRow + 3, dColumn)
Sheets(1).Cells(dRow + 3, dColumn) = FindLargest(rDestination)
CommentText = FindLargest(rDestination, True)

'Add Comment
Sheets(1).Activate
Sheets(1).Cells(dRow + 3, dColumn).Select
Sheets(1).Cells(dRow + 3, dColumn).AddComment
Sheets(1).Cells(dRow + 3, dColumn).Comment.Visible = False
Sheets(1).Cells(dRow + 3, dColumn).Comment.Text Text:=CommentText

' Format Time
WaitMin = Application.WorksheetFunction.RoundDown(Sheets(1).Cells(dRow + 3, dColumn) / 60, 0)
If WaitMin > 60 Then
WaitHour = Application.WorksheetFunction.RoundDown(WaitMin / 60, 0)
WaitMin = WaitMin Mod 60
Else
WaitHour = 0
End If
WaitSec = Sheets(1).Cells(dRow + 3, dColumn) Mod 60
WaitTime = WaitHour & &quot;:&quot; & WaitMin & &quot;:&quot; & WaitSec

Sheets(1).Cells(dRow + 3, dColumn) = WaitTime

' Format Cell
Sheets(1).Activate
Sheets(1).Cells(dRow + 3, dColumn).NumberFormat = &quot;h:mm:ss&quot;
Sheets(1).Cells(dRow + 3, dColumn).Select
With Selection
.HorizontalAlignment = xlCenter 'centre align cell
End With
With Selection.Font
.Size = 9
.Bold = True
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

' Clear Temp Sheet
Sheets(&quot;Temp&quot.Activate
Cells.Select
Selection.ClearContents
Selection.QueryTable.Delete
Sheets(1).Activate

Team = &quot;Team 2&quot;
dRow = dRow + 9
Next Q

' Do Clean Up
Sheets(&quot;Temp&quot.Select
ActiveWindow.SelectedSheets.Delete

' Delete Names created by SQL Queries
For Each oName In Names
Names(oName.Name).Delete
Next oName

Sheets(1).Activate
Sheets(1).Cells(1, 1) = &quot;&quot;
Sheets(1).Range(&quot;A2&quot.Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End

End Sub

Zathras' code
Function FindLargest(Ref As Range, Optional FindAddress As Boolean = False)
' Finds largest number in a range of numbers
' Optionally if parameter2 is True, returns address instead of number
Dim c As Range
Dim sAddress As String
Dim nDelta As Double

FindLargest = WorksheetFunction.Max(Ref)

If FindAddress Then
nDelta = 99999
For Each c In Ref
If Abs(c - FindLargest) < nDelta Then
nDelta = Abs(c - FindLargest)
sAddress = Format((c.Offset(0, -1) + 0.0417), &quot;H:MM AMPM&quot
End If

Next c
FindLargest = sAddress
End If

End Function