ranking a list

[lior03]

hello
i wanted to rank items in a numeric list.
how can i make the active cell move along my selection and using a msgbox rank the list?
my code:

Dim cell As Range
Dim r As Integer
For Each cell In selection
cell.Select
r = Application.WorksheetFunction.Rank(cell, selection, 0)
MsgBox " the present cell is ranked " & r & " in the list "
Next

thanks

[ALe]

Dim cell As Range
Dim r As Integer
Dim MyRange As Range
Set MyRange = Selection
For Each cell In MyRange
cell.Select
r = 1 + MyRange.Cells.Count - Application.WorksheetFunction.Rank(cell, MyRange, 0)
MsgBox " the present cell is ranked " & r & " in the list "
Next

[lior03]

hello
maybe i was not clear enough.
i want the mouse indicate the active cell as i move along the list and the msgbox provide information about the rank
thanks

[geekgirlau]

I don't know how you expect the mouse to indicate the active cell - the code selects the active cell so that you can see which cell is being referred to. If you are looking for a mouse action to trigger the macro, you have to at least select the cell - I don't believe there's an action related to hovering above a cell.

[lior03]

hello
here is the complete code:

Sub rankalist()
On Error GoTo errhandler
Dim cell As Range
Dim r As Integer
Dim m As Integer
m = selection.Count
MsgBox " selection has " & m & " cells .", vbInformation, "selection count"
For Each cell In selection
If IsEmpty(selection) Then Exit Sub
If Not IsEmpty(selection) Then
cell.Activate
r = Application.WorksheetFunction.Rank(cell, selection, 0)
MsgBox " the present cell is ranked " & r & " in the selection.", vbExclamation, "rank a selection"
End If
Next
Exit Sub
errhandler:
MsgBox " sorry selection empty", vbCritical, "AN ERROR MESSAGE"
End Sub

[ALe]

I can't understand what you want to do. Maybe if you tell us step by step about your project we can understand.

[lior03]

hello
i was finally able to get what i wanted-rank a selection as well as getting the sum & average.
what left is format the average from say 45.18181818 to 45.19 . can it be doen?

On Error GoTo errhandler
Dim cell As Range
Dim r As Integer
Dim m As Integer
m = selection.Count
MsgBox " selection has " & m & " cells ." & Chr(13) & " the sum is : " & Application.WorksheetFunction.Sum(selection) & Chr(13) _
& "the average is :" & Application.WorksheetFunction.Average(selection), vbInformation, "selection count & sum & average" & Chr(13)
For Each cell In selection
If IsEmpty(selection) Then Exit Sub
If Not IsEmpty(selection) Then
cell.Activate
r = Application.WorksheetFunction.Rank(cell, selection, 0)
MsgBox " the present cell is ranked " & r & " in the selection.", vbExclamation, "rank a selection"
End If
Next
Exit Sub
errhandler:
MsgBox " sorry selection empty", vbCritical, "AN ERROR MESSAGE"


thanks

[mdmackillop]

You could add this information using VBA to create comments attached to each cell. This would then be visible using mouse over. This would require a little bit of effort, and maybe only worth doing if it will be used repeatedly
Regards
MD

[lior03]

my solution:

On Error GoTo errhandler
Dim cell As Range
Dim r As Integer
Dim m As Integer
Dim n
Dim g
m = selection.Count
n = Application.WorksheetFunction.Sum(selection)
g = Application.WorksheetFunction.Average(selection)
MsgBox " selection has " & m & " cells ." & Chr(13) & " the sum is :" & n & Chr(13) _
& "the average is :" & Format(g, "#,##0.00"), vbInformation, "selection count & sum & average" & Chr(13)
For Each cell In selection
If IsEmpty(selection) Then Exit Sub
If Not IsEmpty(selection) Then
cell.Activate
r = Application.WorksheetFunction.Rank(cell, selection, 0)
MsgBox " the present cell is ranked " & r & " in the selection.", vbExclamation, "rank a selection"
End If
Next
Exit Sub
errhandler:
MsgBox " sorry selection empty", vbCritical, "AN ERROR MESSAGE"


thanks

[fanjy]

see:
Option Explicit
Dim MyCell As Range
Dim r As Integer
Dim MyRange As Range
Dim Ans
Sub rankalist()
Dim m As Integer
Set MyRange = Selection
m = Selection.Count
MsgBox "Selection has " & m & " cells.", vbInformation, "Selection Count"
Call rankprocess

While Ans = vbYes
Call rankprocess
Wend

While Ans = vbNo
Exit Sub
Wend
End Sub
Sub rankprocess()
Set MyCell = Application.InputBox(prompt:="Please select a cell:", Title:="Cell", Type:=8)

If Union(MyCell, MyRange).Address = MyRange.Address Then
r = 1 + MyRange.Cells.Count - Application.WorksheetFunction.rank(MyCell.Value, MyRange, 0)
Ans = MsgBox(" the present cell is ranked " & r & " in the list " & vbNewLine & "Continue?", vbYesNo)
Else
MsgBox "Please select a cell in selection."
End If
End Sub