How to find and color duplicate values with Excel and VBA

by admin No comments »

The obvious answer to the above question could be “by using conditional formatting, fool!” That’s true.  We could easily write a formula checking if the value just entered is a duplicate and, if it’s true, change accordingly the cell background color. We could ….. but

… what I really want is to use the same color for each duplicated value. And at the same time, use a different color for different values. It might sound complicated, but is not and the animation below should settle all the doubts.

How to find and color duplicate values with Excel and VBA

I also like the idea of having an option of easily changing the colors. To be honest, I don’t have a clue about how I could accomplish it with conditional formatting only.  And since I don’t have a clue I decided to use VBA.

In the first step I prepared a list of colors I want to use. It’s nothing, but a range with colored cells (we simply use Excel formatting).

How to find and color duplicate values with Excel and VBA

We can easily choose and change colors for duplicate values

Every time our macro finds a duplicate value in a chosen column, it will get the color from one of previously colored cells (our color list mentioned above).  Starting from the top one and moving down. When it reaches the end it will – surprise, surprise :) – start from the beginning.

Because I want my macro to run and refresh cell colors every time I change a value in a selected row I assigned the macro to Excel onChange event. And finally, my macro:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rngKolory As Range

Dim rngDoPokolorowania As Range

Dim LicznikKolorow As Integer

Dim Licznik As Integer

Dim rngKolumna As Range

Dim rngDaneWypelnione As Range

' cells with colors to choose from

Set rngKolory = wksKolory.Range("rngKoloryStart").Resize(wksKolory.Range("settIleKolorow").Value, 1)

' cells with data to be "colored"

Set rngDoPokolorowania = wksDane.Range(Range("rngDaneStart"), Cells(65535, Range("rngDaneStart").Column).End(xlUp))

' column with data

Set rngKolumna = Columns("B")

With wksDane

Set rngDaneWypelnione = .Range(.Range("rngDaneStart"), .Range("rngDaneStart").Offset(10000).End(xlUp))

End With

If Not Intersect(Target, rngKolumna) Is Nothing Then

Application.ScreenUpdating = False '

' Let's clear the whole data area (set background color to default)

rngDaneWypelnione.Resize(rngDaneWypelnione.Count + 1).Interior.ColorIndex = _

wksKolory.Range("rngDomyslneTlo").Interior.ColorIndex

LicznikKolorow = 1 ' color counter reset

With rngDoPokolorowania

' first cell

If Application.WorksheetFunction.CountIf(rngDoPokolorowania, .Cells(1).Value) > 1 Then

.Cells(1).Interior.ColorIndex = rngKolory.Cells(LicznikKolorow).Interior.ColorIndex

LicznikKolorow = LicznikKolorow + 1

If LicznikKolorow > rngKolory.Count Then LicznikKolorow = 1

End If

'more than one cell

If rngDaneWypelnione.Count > 1 Then

' for following cells

For Licznik = 2 To .Count

If Application.WorksheetFunction.CountIf(rngDoPokolorowania, _

.Cells(Licznik).Value) > 1 Then

If Application.WorksheetFunction.CountIf(Range("rngDaneStart").Resize(Licznik - 1), .Cells(Licznik).Value) > 0 Then

.Cells(Licznik).Interior.ColorIndex = _

rngDaneWypelnione.Find(what:=.Cells(Licznik).Value, after:=.Cells(Licznik), SearchDirection:=xlPrevious, lookat:=xlWhole).Interior.ColorIndex

Else

.Cells(Licznik).Interior.ColorIndex = rngKolory.Cells(LicznikKolorow).Interior.ColorIndex

LicznikKolorow = LicznikKolorow + 1

If LicznikKolorow > rngKolory.Count Then LicznikKolorow = 1

End If

End If

Next Licznik

End If

End With

Application.ScreenUpdating = True

End If

End Sub

This might not be the most optimal solution, but in simple cases will play it’s role just fine.

Marcin

Creating a bestseller (Top 10) list with Excel

by admin No comments »

Today we are going to create a bestseller (top 10) list. As a source material we will use a list of products with a corresponding number of products sold within a chosen period of time.

What we want at the end is to generate a list of top 10 selling products. To make it slightly more difficult we want this list to automatically update every time the number of products sold changes, and – just for fun – we don’t want to use VBA macros.

Creating a bestseller (top 10) list in Excel

First, let’s sort (descending order) all the sale figures and choose 10 best ones. To do so I decided to use the function LARGE and an array formula entered into the range I7:I16 spanning over 10 Excel cells. Our array formula looks as follows:

=LARGE(Sheet1!C4:C19,ROW(INDIRECT("1:"&ROWS(Sheet1!C4:C19))))

Where C4:C19 is a range with our sold products amounts.

Creating a bestseller (top 10) list in Excel

As a result we get a list of top 10 sales.

Creating a bestseller list in Excel
Now, the more difficult part. How to assign product names to the numbers ?

If we were sure that the numbers of sold products will never be the same (we don’t have any recurrent values) we could simply use INDEX and MATCH functions to match the appropriate product name to the number. Our formula could look like this:

=INDEX(Sheet1!B4:B15,MATCH(C6,Sheet1!C4:C15,0),1)

And it should work fine. But, if the sale amounts repeat, the above formula will return the same product name for each repeating number.

Excel and a bestseller list

That is not what we want. That’s why I decided to use a little different approach. To get the first product name I used the formula:

=INDEX(Sheet1!B4:B19,MATCH(F6,Sheet1!C4:C19,0),1)

And for the following product names, an array formula

=INDIRECT("Sheet1!"&ADDRESS(SMALL(IF(Sheet1!$C$4:$C$19=F7,ROW(Sheet1!$C$4:$C$19),65536),COUNTIF($F$6:F7,F7)),2))

inserted into one cell and copied over the remaining 8 cells.

Excel and a bestseller list

As you can see on the animation in the beginning of this post, the solution seems to work just fine. Every change in the sold products amount, results automatically in an adjusting change on our TOP 10 list. Enjoy!

Marcin