Solved

Excel 2010, Highlight Unique top 10 and bottom 10 dates in column

Posted on 2011-02-16
8
450 Views
Last Modified: 2012-08-14
Hi, as per the title...

I have a list of 80 dates that I would like to highlight the top 10 unique values.  It is the 'unique' part I am having a problem with as there a multiple entries with the same date.  I would like all entries with the same date to only be recognised as only 1 value within the top 10.  So there could be 18 of the 80 dates that fall within the top ten highest date range.   Then I want to be able to highlight the 18 entries.  Similar issue with the bottom 10.  The worksheet has two separate macros to sort by two different columns so the cells will move per the sorting rules and rows are deleted and added as required.  I would like not have to re-enter the formulas each time a row is deleted or added.
0
Comment
Question by:stormitex
  • 3
  • 2
  • 2
  • +1
8 Comments
 
LVL 12

Expert Comment

by:sstampf
ID: 34913458
Try this code and let me know if you have any questions.

Shashank
Sub Macro1()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim rng1 As Range
    Dim i As Integer, lstRow As Long
    Set ws1 = ActiveSheet
    Set rng1 = Application.InputBox("Select Target Column", , , , , , , 8)
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets.Add
    Set ws2 = ActiveSheet
    rng1.Copy
    ActiveSheet.Paste
    ActiveSheet.Range("$A$1:$A" & Rows.Count).RemoveDuplicates Columns:=1, Header:=xlGuess
    ws2.Sort.SortFields.Clear
    ws2.Sort.SortFields.Add Key:=Range("A1:A" & Rows.Count) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ws2.Sort
        .SetRange Range("A1:A" & Rows.Count)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    lstRow = ws2.Range("A" & Rows.Count).End(xlUp).Row
    ws1.Activate
    For i = 1 To 10
    rng1.Select
    Selection.Find(What:=CDate(ws2.Range("A" & i).Value), After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
       Selection.Interior.Color = vbYellow
    Next i
    For i = (lstRow - 10) To lstRow
    rng1.Select
    Selection.Find(What:=CDate(ws2.Range("A" & i).Value), After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
       Selection.Interior.Color = vbGreen
    Next i
    ws2.Delete
    Application.CutCopyMode = False
    Set rng1 = Nothing
    Set ws1 = Nothing
    Set rng2 = Nothing
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Open in new window

0
 
LVL 41

Expert Comment

by:dlmille
ID: 34913577
@sstampf - good tip - I tried to do this with conditional formatting and the results weren't consistent at all!  

However - one error, I believe, in your code (unless I'm counting wrong, this tested with data in attached...  Gives 11 greens, unless you make the following change:

The second loop should be:

    For i = (lstRow - 9) To lstRow 'lstRow -9 not lstRow-10    
    rng1.Select
    Selection.Find(What:=CDate(ws2.Range("A" & i).Value), After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Select
       Selection.Interior.Color = vbGreen
    Next i
12/6/2008
12/6/2008
12/6/2008
12/6/2008
12/6/2008
12/6/2008
12/6/2008
12/6/2008
12/6/2008
12/6/2008
12/6/2008
9/1/1990
4/20/2000
6/25/1995
11/5/2001
1/15/2000
12/14/2008
11/11/2006
1/23/1998
7/26/1995
2/9/1992
12/16/1990
12/2/1995
10/9/1991
8/13/1991
8/30/1993
8/2/2003
8/8/2007
10/24/1995
11/20/2000
6/5/1997
1/9/1999
6/8/2003
3/29/2000
6/14/2001
3/8/1998
8/17/1991
1/29/1994
4/24/1996
11/8/1995
10/7/1998
9/16/1991
11/28/1997
11/19/2007
9/17/2003
2/20/2005
4/18/2007
5/26/2005
9/19/1996
3/16/1990
1/21/2006
1/13/2011
5/16/2006
1/22/1991
3/30/2008
7/2/2010
2/6/2002
6/1/2003
11/14/1991
10/3/1995
11/25/1996
4/16/2005
11/3/1999
3/15/1999
9/13/2003
1/14/2004
11/12/1992
11/1/2001
4/25/1997
5/11/1995
12/27/2010
9/9/2004
11/9/2004
5/23/1992
4/24/1990
10/16/2004
11/5/1990
1/23/1994
12/4/1992
1/6/2009
1/31/2003
1/10/1998
1/7/2003
7/26/2008
6/28/1996
11/12/1990
7/29/2006
2/15/2006
9/29/1995
9/30/1997
4/15/2009
9/8/2008
7/17/2001
11/13/1991
7/5/2001

Open in new window

0
 
LVL 12

Expert Comment

by:sstampf
ID: 34913850
Good catch dlmille. Thanks for suggesting this improvement.

@stormitex, I want to point out that I didn't included headers in my test data set while building this code so if your data set has headers you may want to change line no 27 of my code to say:
for i=2 to 11

Let me know if you have any questions/concerns.
0
 
LVL 50

Accepted Solution

by:
barry houdini earned 250 total points
ID: 34914883
You can do this with "regular" conditional formatting without VBA if you want. I think it's robust enough to withstand sorting and/or deleting rows but it might depend exactly how you do that, e.g. deleting 2 rows in the middle of the range will be OK, deleting all the conditionally formatted rows won't be.

I put dates in A2:A100 (with some blanks to see what happens to those) and used this formula for the top 10 (latest different dates)

=SUMPRODUCT((A$2:A$100>A2)/COUNTIF(A$2:A$100,A$2:A$100&""))<10

and this formula for the bottom 10

=(SUMPRODUCT((A$2:A$100<A2)*(A$2:A$100<>"")/COUNTIF(A$2:A$100,A$2:A$100&""))<10)*(A2<>"")

see attached

You can press F9 to re-generate random dates to see how the conditional formatting changes, these will all be within a 100 day period so there will normally be some duplicates..........

Note that theoretically you only need SUM rather than SUMPRODUCT in these formulas but in practice in Excel 2007, in which I'm working, using any formulas in conditional formatting that would need "array entering" if they were on the worksheeet causes problems when the workbook is re-opened (CF doesn't update correctly)

regards, barry
26827591.xlsx
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 41

Expert Comment

by:dlmille
ID: 34917622
@Barry, I knew there had to be a conditional formatting solution, but at the time, I couldn't get my mind to think in SUMPRODUCT mode :)

I get it - but, what does the &"" do for the formula?
and, why did the bottom 10 need the additional (A2<>"") as opposed to the top 10?

Dave
0
 
LVL 50

Expert Comment

by:barry houdini
ID: 34920169
Hello Dave,

The &"" makes the formula work correctly if the range includes blanks.

If you try this formula on the worksheet

=COUNTIF(A1:A10,A1:A10)

then that returns an array of ten values, and if any cell in A1:A10 is blank the corresponding value is zero, which is a problem in the larger formula because we are diving by the COUNTIF result, so any zeroes will lead to a #DIV/0! error. The fix is to use

=COUNTIF(A1:A10,A1:A10&"")

because now any blanks in A1:A10 will result in a return of 1

blank cells will also be formatted as part of the bottom 10 (because they are deemed to be zeroes) so you need to explicitly exclude those with the extra condition, A2<>""

regards, barry
0
 
LVL 41

Expert Comment

by:dlmille
ID: 34920895
@Barry-you are indeed the formula wizard.  Thanks, I'll tuck that away in my knowledgebase!

Dave
0
 

Author Closing Comment

by:stormitex
ID: 34921856
Barry.....one word.....Genius!!
Thanks heaps!

Thanks for the code too sstampf.  Conditional formatting makes life much more simpler.
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate in Google Sheets how to use the HYPERLINK function to create live links inside your spreadsheet.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

18 Experts available now in Live!

Get 1:1 Help Now