Copy Unique Values

One of the more frequent activities I perform is taking a list and extracting unique values as a seperate list.

The way to do this is long and stupid.
In Excel 2003 you select your range, go to the Data menu, Filter menu, select Advanced Filter. Select “Copy to another location”, tick “Unique records only”, then put a range in the “Copy To” box.
In Excel 2007 and above, it’s one less click. Go to the Data ribbon, from the Sort & Filter group click Advanced, then the same Advanced Filter window appears as Excel 2003.

Sick of this, a few years ago I wrote a macro to extract Unique Values, which worked so-so. My macro had minor issues that I could never really be bothered fixing, but it was miles better than trekking through those menus.
Fast forward to a couple of weeks ago and I lost my macro, somehow, which is disappointing, but it was buggy anyway, but I still wanted an easy way to extract unique values and I didn’t want to write the macro again.
It suddenly occurred to me that the same method of hitting shortcuts keys for paste values (alt, e, s, v) could be applied to copying unique values.

Here’s what I do:
Select the range I want to extract from
Hold down the Alt key
Press these keys in sequence: d, f, a, r, o, t
Release the Alt key
Select the range to paste the unique values to

It’s even possible to create a vba macro for this:
SendKeys "%(dfarot)"

Now, to train my muscle memory to type dfarot naturally…

Copy Chart as a Picture

I needed to copy a chart to a picture, but I wanted it to be an enhanced metafile (EMF) which is kind of like a vector graphic picture format. EMF graphics scale well when the page resizes.

A user would select the chart, run the macro and a dialog would ask them where to save the picture to – pretty simple, but handy!
It uses the clipboard to do the conversion.

Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Declare Function CloseClipboard Lib "user32" () As Long
Declare Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Declare Function EmptyClipboard Lib "user32" () As Long
Declare Function CopyEnhMetaFileA Lib "gdi32" (ByVal hENHSrc As Long, ByVal lpszFile As String) As Long
Declare Function DeleteEnhMetaFile Lib "gdi32" (ByVal hemf As Long) As Long

Const CF_ENHMETAFILE As Long = 14
Const cInitialFilename = "Picture1.emf"
Const cFileFilter = "Enhanced Windows Metafile (*.emf), *.emf"

Public Sub SaveAsEMF()
Dim var As Variant, lng As Long

var = Application.GetSaveAsFilename(cInitialFilename, cFileFilter)
If VarType(var) <> vbBoolean Then
On Error Resume Next
Selection.Copy

OpenClipboard 0
lng = GetClipboardData(CF_ENHMETAFILE)
lng = CopyEnhMetaFileA(lng, var)
EmptyClipboard
CloseClipboard
DeleteEnhMetaFile lng
On Error GoTo 0
End If
End Sub

Populating Class Properties

Depending on the requirements, I’ll choose a method for populating my custom collection classes using from data from a worksheet.

In this example, I’m using a list of the best selling albums of all time.

My Album class has properties as follows:

The code in my main routine is:

Filling the collection is just a matter of reading each row and popping the contained values into the right property.
The difficulty is knowing which columns relate to what properties. It’s a mapping problem – mapping columns to properties.

I could make an assumption about the positions of the columns and assume each is a known index.

I don’t really like this because I’ve been taught and have tried to follow the approach that offsets/indices like these should be defined as constants.
I’ll modify my FillFromSheet code.

Seems roughly better, but this too has problems. It can be a pain when you want to change the column order or insert a new column. You’d have to go through the code and update all of the numbers. While this is ok for 5, as I have here, changing out 50 columns is a chore.

So, I use an Enum block to determine column positions. At the top of the class module:

And another modification to my FillFromSheet code:

That works well. If I rearrange my columns on the worksheet, the only code change needed is a swap of items in the Enum block – a painless and quick update!

But that’s only if the changes to column order are in my control. What if an end user changes the column order? Do I really want them poking around in my Enum code too? I’d usually stop now and decide that if the end user starts screwing with column positions, it’s fair enough that the code should break. However, if I wanted to go the extra mile, I’d have to find the column index by searching for the text in the column headers.

Excel 2007 (and 2003 to an extent) has a feature called Tables, otherwise known as ListObjects.

My code in the main routine changes to:

… and the code in my collection class is:

In the preceding code I created a collection of key-value pairs. The key is the column label, the value is column index. I use that as a lookup when populating my properties.

That’s just a few approaches to reading a table of values into a collection. I’m interested in feedback. How do you map column positions to properties?

Sorting a Custom Collection Class

I’ve been following Dick’s VBHelpers Build series (1, 2, 3) and his last post reminded me that, from time to time, I need to sort a collection of items in-memory.

I don’t have to sort all that often, so my approach has changed over time. I’ve kind of settled on the following.

Let’s say I have a People collection that contains Person items.

In my Person class I’ve written a method (Function) called CompareTo. It works a lot like VBA’s StrComp, returning -1, 0 or +1 depending on whether Item 1 is less than or greater than Item 2.

I’d use it against two person items: person1.CompareTo person2

In my People collection class, I’ve created a method called Sort that returns itself in sorted order.

It’s an Insertion Sort that I converted from Wikipedia’s article into VBA. Notice how it uses the CompareTo method for deciding on item placement.

Now I get to use the above in my main code routines:

The code above is available for download. It’s an extension of the code I posted a year ago on the same topic (links 1, 2). It also includes the Enum enhancements suggested by Andy Pope way back then.

You can download SortClass.zip

Good Row Bad Row

In the office, I sometimes deal with a table of values. In that table, there are good rows, and bad rows.
I want to quickly put the good rows to the top of the table, and leave the bad rows at the bottom of the table.

So I take the first unused column, give it a rubbish column header, such as “qwe”, and build a formula in the next row down ready to autofill.
The formula will return TRUE for the goodies, and FALSE for the baddies.
After an autofill, I’ll sort descending by that column, which puts the goodies at the top.
Usually the formula will be something simple, like

=TRIM(A2)=A2

In that way, all of the bad rows can be dealt with as a group, rather than scanning through the rows fixing one at a time.

There’s another one I regularly do. It’s “is this value in my other list”. Kind of like an integrity check.
I’ll have two tables – a primary table and a secondary table. I need to know if rows in my primary table are linked to rows in my secondary table.
For example, Employee not in Attendees list. Purchase Order not in Invoices list.
I’ll build a column on the side of the primary table that returns either TRUE or FALSE and use a lookup formula to do the work.
Once I have a column of TRUEs and FALSEs, it’s a simple matter to sort, then focus on the baddies.

In fact, I do these types of yes/no lookups so often that I remember the pattern to building the formula off by heart. Sad, but true.

1. NOT followed by ISNA followed by MATCH

=NOT(ISNA(MATCH(

2. Value to look up

                A1,

3. List to look up

                    B3:B9,

4. 0 for exact match

                           0

5. three closing brackets

                            )))

6. Highlight the “list to look up” text and hit the F4 key to make it absolute.

=NOT(ISNA(MATCH(A1, $B$3:$B$9, 0)))

Now that I think about it, I’ve probably typed that line of text over 1000 times and I really should write a macro for that.

While I’m writing about the lookup, here’s a way of doing a lookup all without an external list.
It’s possible to bring, for example, B3:B9 into the formula while still retaining the MATCH function – what I call an inline lookup.
Simply highlight the B3:B9 text, and press F9 on your keyboard.
By pressing F9, it brings the list into your formula as an array.

=NOT(ISNA(MATCH(A1, {“Apple”;”Banana”;”Orange”;”Strawberry”;”Grape”;”Mango”;”Lemon”}, 0)))

goodrowbadrow

Usually you’ll want to leave the list as a range of its own, but depending on the occasion, it could be tidier to have it inline.

Class Property Fixed Values

In my previous post on a Custom Collection Class, I used an example of a People collection with Person items.

As well as First Name, Last Name, and City, I had originally included the Gender property (Female, Male, Unknown), but removed it just prior to posting. I purposely left it out because I didn’t want to distract from the core topic (collection classes), and because I have a special way of dealing with properties of this type.

I could have just defined Gender as a String datatype.

That would work.

We could be a little more rigid with our variable, and define an Enum.

It’s an OK approach, though it has a couple of small issues.

  • I can set Gender to numbers other than the Enums 0, 1, and 2. MyPerson.Gender = 7 will not error.
  • The required helper functions GenderEnumToString, and the StringToGenderEnum are stored in a separate place to the Gender variable, probably buried in a giant module. While it’s improbable that there will be more than 2 genders, your property might grow over time. It’s nice to have related code all in the same place.

What follows is a different approach that mixes Classes with Enums. You get the validation capability of a Class property, the Intellisense of an Enum, and related code living in the same place.

You get code that reads like

This example starts where the Custom Collection Class post ends. It is assumed you have the same example ready to use.

As in the first post, we’ll persevere with the VBA Attribute workaround. Copy the following code to Notepad, save as Gender.cls, then use VBA to Import the file. Did you know that instead of clicking File > Import, you can drag’n’drop the file from Windows Explorer to the Project window?

Notice in the code above the line that reads: Attribute Value.VB_UserMemId = 0. That line is the one thing that makes us perform the Notepad workaround, but it is pretty important that we do it. The Attribute tells VBA the Value property is the Default property for the Class. For further reading, take a look at Chip Pearson’s explainer of the feature.

There’s also a couple of Consts defining the valid range of Gender values allowed: LoLimit and HiLimit. As a Gender value is assigned, validation is performed against these Consts through Property Let Value.

Now we can add our Gender property to the Person class. The Person class should now look as follows:

Great! Now we’re ready to test it.

I’ve put together a workbook containing the code of this post, and also the code of my previous post.

You can download Gender_Class.zip

Custom Collection Class

When I first started programming in Excel VBA, I had problems using Class modules.
I had done plenty of reading on Object Oriented programming, but I just didn’t understand the attraction.
Years of programming in assembly language had wired my brain in a way incompatible with OO and every time I tried to use Classes and Collections, I quickly became frustrated and reverted back to my old ways.
My ways consisted of modules of Functions, and managing “lists of things” using Arrays and User Defined Types.

I suppose it had to happen at some time, but eventually it all clicked and now I want to use this approach for every programming assignment I take on.

For this article, we’re going to create a collection of People, and write code dealing with those people.

Start off with a blank workbook, and add a 3 column list of people: First Name, Last Name, City.
I used Dick’s Generate Sample Data add-in to build a list of 50 people.
I copy-pasted the first 10 cities against the remaining rows just so there are many people for any one city.
Later on in the post I’ve made an assumption that the list contents start on row 2 so please construct your layout so it appears like the screenshot.

customcollectionclass_1

Add a Class Module called Person.
Copy-Paste the following code in:

Option Explicit

Public FirstName As String
Public LastName As String
Public City As String

The next step is to add a Custom Collection Class. It’s really just a wrapper around the built-in Collection class. I use this as a Template, and search-replace Person / People.
I wish it were as easy as dropping the code into a new Class module, but you’ll need to do this little workaround instead.
You see, we need a few Attribute modifiers to alter the behaviour of two important properties, and it’s not possible to edit Attribute modifiers from VBA’s User Interface.
If you didn’t attach the Attribute modifiers, the Item property would not be the default property, and you would lose the ability to For Each / Next on the Collection.

So, using Notepad, save the following code as People.cls, then from VBA > File > Import File, and import People.cls.

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  ‘True
END
Attribute VB_Name = “People”
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Private objPeople As Collection

Private Sub Class_Initialize()
    Set objPeople = New Collection
End Sub

Private Sub Class_Terminate()
    Set objPeople = Nothing
End Sub

Public Property Get NewEnum() As IUnknown
Attribute NewEnum.VB_UserMemId = -4
Attribute NewEnum.VB_MemberFlags = “40”
    Set NewEnum = objPeople.[_NewEnum]
End Property

Public Sub Add(obj As Person)
    objPeople.Add obj
End Sub

Public Sub Remove(Index As Variant)
    objPeople.Remove Index
End Sub

Public Property Get Item(Index As Variant) As Person
Attribute Item.VB_UserMemId = 0
    Set Item = objPeople.Item(Index)
End Property

Property Get Count() As Long
    Count = objPeople.Count
End Property

Public Sub Clear()
    Set objPeople = New Collection
End Sub

We’ll need a way of filling the Collection. I like adding a method to the Collection class called FillFromXYZ where XYZ could be a Sheet, or a Database, or an XML source, or anything really.
Add this code to the end of the People class

Public Sub FillFromSheet(wks As Worksheet)
    Const cFirstRow = 2, cFirstNameCol = 1, cLastNameCol = 2, cCityCol = 3
    Dim i As Long, obj As Person

    With wks
        For i = cFirstRow To .Cells(Rows.Count, 1).End(xlUp).Row
            Set obj = New Person
            obj.FirstName = .Cells(i, cFirstNameCol)
            obj.LastName = .Cells(i, cLastNameCol)
            obj.City = .Cells(i, cCityCol)

            Me.Add obj
        Next
    End With
End Sub

Great! We’ve got all the ingredients readied for some testing.

We can loop through all of items in a list using For Each / Next
Insert a new Standard Module, and copy-paste this code in, then run it.

Sub test()
    Dim ppl As People, per As Person

    Set ppl = New People
    ppl.FillFromSheet ActiveSheet

    Debug.Print “Test 1: return all People”
    For Each per In ppl
        Debug.Print per.FirstName; vbTab; per.LastName; vbTab; per.City
    Next
End Sub

We can select a specific item in the list, accessed by Index number

    Debug.Print “Test 2: return a single Person”
    Debug.Print ppl(2).FirstName; vbTab; ppl(2).LastName; vbTab; ppl(2).City

We can filter the list by criteria
Add this code to the end of the People class …

Public Function FilterByCity(str As String) As People
    Dim ppl As People, per As Person

    Set ppl = New People

    For Each per In Me
        If per.City = str Then ppl.Add per
    Next

    Set FilterByCity = ppl
End Function

… then run Test 3

    Debug.Print “Test 3: return all People of a specific City”
    For Each per In ppl.FilterByCity(“New York”)
        Debug.Print per.FirstName; vbTab; per.LastName; vbTab; per.City
    Next

I suppose the thing I like the most about custom collection classes is the ability to do Method Chaining (methods of a collection that return a collection of the same class)

Here’s how we can link Filter methods together.
Add this code to the end of the People class …

Public Function FilterByLastNameLike(str As String) As People
    Dim ppl As People, per As Person

    Set ppl = New People

    For Each per In Me
        If per.LastName Like str Then ppl.Add per
    Next

    Set FilterByLastNameLike = ppl
End Function

… then run Test 4

    Debug.Print “Test 4: return all People of a specific city and similar name”
    For Each per In ppl.FilterByCity(“Athens”).FilterByLastNameLike(“*h*”)
        Debug.Print per.FirstName; vbTab; per.LastName; vbTab; per.City
    Next

We could go further with options like adding an OrderBy function:

For Each per In ppl.FilterByCity(“Athens”).FilterByLastNameLike(“*h*”).OrderByLastName

or returning arrays, or lists of unique entries

str() = ppl.FilterByLastNameLike(“*h*”).UniqueCities

By using Custom Collection Classes, it allows me to program against lists within the comfort of VBA.
It takes a little bit more set up to begin with, but allows the production of elegant code at the end.

VBA Rounding

When comparing values from various systems, I’d sometimes notice $0.01 differences.
I put the differences down to rounding, but it seemed that no matter which approach I took, the differences could not be reconciled.
It’s one of those things that really bugged me, and I’d feel guilty if I spent too much time on the problem… after all, the differences added up to a lot less than the cost of my time.

The other day when I was comparing values in Excel I used the =ROUND() function and was shocked to see my old friend, the $0.01 difference.
The originating system was one designed by me using VBA, so I took the opportunity to look a bit deeper.
After some time, I isolated the problem to the VBA Round function.

In the image below, A1 to A20 are digits 0.0 to 1.9, B1 downward contains the formula =ROUND(A1, 0), and C1 down contains the formula =VBA_Round(A1, 0).
VBA Round

VBA_Round is a user defined function:

Function VBA_Round(number As Double, num_digits As Long) As Double
    VBA_Round = Round(number, num_digits)
End Function

Excel will round 0.5 to 1, and VBA will round 0.5 to 0, yet they’ll both round 1.5 to 2.

It turned out that Excel and VBA use a different method of rounding, and it is by design.
Excel uses arithmetic rounding, and VBA uses Banker’s rounding. Bankers rounding means that you round a 5 to the nearest even number. There’s even a Microsoft Knowledge Base article about it.

For further reading, EWBI also has very good information on the topic.