Highest & lowest Numbers

ibrahimaa · #1 04-16-2012, 03:56 AM

In the attached Xls file, column “B” represent the number of employees pertain to each Department in column “A”.

As per file instruction, the end user will have to highlight the 3 Departments that have the highest (or lowest) number of employees.

I want the macro to check if the end user did this or not and promote him with a message if he did not.

I know only parts of the required codes and I would appreciate any help to complete it. Thanks.

Code:

With Selection.Pattern
Pattern = xlNone ‘this mean it is not highlighted in any color 
Call MsgBox("you have not 3 Departments that have the highest number of employees – Pls try again", vbOKOnly, "WARNING")

Catalin.B · #2 04-17-2012, 06:21 AM

You can start from these codes, to find the highest or lowest 3 departments, and to check if they are highlighted:

Code:

Sub RankHighest()
Dim i, Rank ', Count
Dim Rng As String
Rng = "B2:B12"
For i = 2 To 12
'Find rank for cell value
Rank = WorksheetFunction.Rank(ActiveSheet.Cells(i, 2), ActiveSheet.Range(Rng))
'Check which departments ranked 1 to 3 are highlighted
If ActiveSheet.Cells(i, 1).Interior.ColorIndex <> -4142 And Rank <= 3 Then
MsgBox ActiveSheet.Cells(i, 1) & " is Ranked " & Rank & " and it is highlighted!"
End If
'Check which departments ranked 1 to 3 are NOT highlighted
If ActiveSheet.Cells(i, 1).Interior.ColorIndex = -4142 And Rank <= 3 Then
MsgBox ActiveSheet.Cells(i, 1) & " is Ranked " & Rank & " and it is NOT highlighted!"
End If
Next i

End Sub


Sub RankLowest()
Dim i, Rank, Count
Dim Rng As String
Rng = "B2:B12"
For i = 2 To 12
'Find rank for cell value
Rank = WorksheetFunction.Rank(ActiveSheet.Cells(i, 2), ActiveSheet.Range(Rng))
'Find how many departments are in range
Count = WorksheetFunction.Count(ActiveSheet.Range(Rng))
'Check if last 3 departments  are highlighted
If ActiveSheet.Cells(i, 1).Interior.ColorIndex <> -4142 And Rank >= Count - 2 Then
MsgBox ActiveSheet.Cells(i, 1) & " is Ranked " & Rank & " from " & Count & " and it is highlighted!"
End If
'Check if last 3 departments  are  NOT highlighted
If ActiveSheet.Cells(i, 1).Interior.ColorIndex = -4142 And Rank >= Count - 2 Then
MsgBox ActiveSheet.Cells(i, 1) & " is Ranked " & Rank & " from " & Count & " and it is NOT highlighted!"
End If
Next i

End Sub

MarvinP · #3 04-17-2012, 11:39 AM

Does the attached with Conditional Formatting help in this problem? No code needed.

ibrahimaa · #4 04-23-2012, 07:52 PM

Catalin.B and MarvinP,
Thanks a lot for your great support.

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Page Numbers Not Matching Chapter Numbers	gracie5290	Word	1	02-02-2012 11:41 PM
Numbers	rdcrags	Word	4	11-13-2011 11:11 AM
HELP...page numbers	BroKyle	Word	3	10-15-2011 08:59 AM
Numbers in Words	janak	Excel	2	12-19-2010 08:53 PM
page numbers and TOC	windon	Word	0	09-09-2009 07:53 AM