Archive for the ‘Collections’ Category.

Catching Paste Operations

You know the situation: You have carefully setup a workbook with intricate Validation schemes. But then along comes your user and he copies and pastes at will. Result: Validation zapped, workbook structure violated.

What to do? The only way I find to be reliable is to catch all possible paste operations. But this isn’t very easy, since there are a zilion ways to paste.

I have put together a sample workbook and an explanatory article on how one could go about protecting a workbook by intercepting paste operations.

Let me know what you think!!

Regards,

Jan Karel Pieterse
www.jkp-ads.com

Collection Add and Functions

When I was creating sample data for Returning a Limited Collection..., I had to fill a bunch of collections with custom classes. Instead of creating the class and adding it to the collection, I created a function that returned the class and use the function call in the Add method. Here's an example:

Set clsGroup = New CGroup
clsGroup.Name = "Group1"
Set colContacts = New Collection
colContacts.Add CreateContact("Dick Kusleika", _
    "Company1", "NE"), "Dick Kusleika"
colContacts.Add CreateContact("John Doe", _
    "Company2", "NE"), "John Doe"
colContacts.Add CreateContact("Jane Doe", _
    "Company2", "MA"), "Jane Doe"
Set clsGroup.Contacts = colContacts
colGroups.Add clsGroup, clsGroup.Name

The CreateContact function looks like this:

Function CreateContact(sName As String, sCompany As String, _
    sState As String) As CContact
   
    Dim clsCon As CContact
   
    Set clsCon = New CContact
   
    clsCon.Name = sName
    clsCon.Company = sCompany
    clsCon.State = sState
   
    Set CreateContact = clsCon
   
End Function

I never thought of calling a function directly from the Add method of a Collection, but I can't think of any reason not to do it.

Returning a Limited Collection from a Class

I have a custom class, CGroup, which has children of the type CContact (another custom class). I need to loop through all the CContacts for each CGroup and print out those that meet a certain condition - in this example, those with State property of "NE". Not all CGroups will have a CContact that meets the condition. The CContact class has Name, Company, and State properties. The CGroup class has a Name property and Contacts collection. In addition, it has a read-only ContactsState property that returns a subset of the Contacts collection that have the provided state.

Public Property Get ContactsState(sState As String) As Collection
   
    Dim i As Long
    Dim colTemp As Collection
   
    Set colTemp = New Collection
   
    For i = 1 To mcolContacts.Count
        If mcolContacts.Item(i).State = sState Then
            colTemp.Add mcolContacts.Item(i), mcolContacts.Item(i).Name
        End If
    Next i
   
    Set ContactsState = colTemp
   
End Property

The data looks like this:

Excel Immediate Window

The final report looks like this:

Excel Immediate Window

In my main sub, I could loop through all of the CContacts for each CGroup and test the State property. If I do that, I need to know beforehand how many CContacts I have in that CGroup so I can tell it when (or if) to print the dotted line that separates them. I could create a property in CGroup that returns that number, but as long I'm looping through the whole collection, I figured I might as well grab the ones I need and return a collection with only those CContacts. I'm not sure if this really saves any cycles because I'm creating a new collection and adding to it rather than just increment a Long counter. But it does have the added advantage of cleaning up the non-class code by removing all that testing for the State.

Sub ListNE()
   
    Dim clsGroup As CGroup
    Dim colGroups As Collection
    Dim colConState As Collection
    Dim i As Long, j As Long
   
    Set colGroups = New Collection
   
    FillGroups colGroups
   
    For i = 1 To colGroups.Count
        Set clsGroup = colGroups(i)
       
        Set colConState = clsGroup.ContactsState("NE")
       
        For j = 1 To colConState.Count
            Debug.Print clsGroup.Name, colConState(j).Name, colConState(j).State
            If j = colConState.Count Then
                Debug.Print String(50, "-")
            End If
        Next j
    Next i
   
End Sub

By working with the limited collection, colConState, it's easy to determine when I've reached the last CContact with NE for the State. Since colConState is an empty collection for Group2 (because it has no CContacts with NE), the inner loop never gets run. Even though I don't show it here, it's probably more important that I properly destroy all of my class references using this method.

You can download LimitChildren.zip to see the whole thing if you like.

Generic undo routine for vba (part 2)

Hi everyone,

Some time ago I published a generic Undo handler for use in Excel VBA on this blog.

In that article I promised to write up how the internals of the technique work.

I've published a new article on my website that explains how things work.

Also, I've added some functionality to each of the pages of the article so you can add your comments on the page itself. Comments written by you will be shown on the same page immediately, giving the pages a blog-like feel to it.

Enjoy (and write comments)!

Regards,

Jan Karel Pieterse
JKP Application Development Services

A menu on a userform

Hi everyone,

I've been fooling around trying to get a tabledriven menu for a
userform to work.

It uses a table on a worksheet to build the menu, like in this screenshot:

Obviously I used a couple of things from Stephen Bullen, Rob Bovey and John Green's famous book "Professional Excel Development" to build this.

I'm almost there I believe (download here).

I'd like to ask you all:

- comments (I might have a hole or two in the logic and in the
termination cleaning up of the class instances)
- A tip on how to get shortcut keys working.

Regards,

Jan Karel Pieterse

Conditional Formats Manager

I've been rewriting some user spreadsheets.

One thing I noticed after a while was that there isn't an easy way to manage Conditional Formats.
As you may know, Conditional Formats use formulas too, so they can be very important to get right - especially if these cells are relied on to highlight errors.

Excel provides some limited ways to manage Conditional Formats.
There's the editor itself: from the Format menu, Conditional Formatting...
and then there's the Goto feature: from the Edit menu, Go To..., Click Special..., Select 'Conditional Formats' (you then have a choice between All or Same).

Those can be challenging to use if you're dealing with a sheet full of various formats.

I put together a userform to list all of the Cells which contain Conditional Formats.
If groups of Cells contain the same Conditional Format then they appear in the same list item.

Click a List Item to select the cells.
Doubleclick a List Item to edit the Conditional Format.

I've not provided an XLA add-in - I'll leave that to you. Here are instructions for building the userform.

Create a new Userform and drop a ListView control onto it. Rename the ListView control: lvwAddress
(Don't have a ListView control in your Toolbox? Right-click in the Controls area, select Additional Controls..., tick Microsoft ListView Control)
Open the code for the Userform and drop the following code in:

Private col As New Collection
 
Private Sub UserForm_Initialize()
    Const cCaption = "Conditional Formats", cKey = "KeyID"
 
    Dim bln As Boolean, str As String, i As Long
    Dim rngAll As Range, rng As Range, rngSel1 As Range, rngSel2 As Range
 
    Me.Caption = cCaption
 
    On Error Resume Next
    Set rngAll = ActiveCell.SpecialCells(xlCellTypeAllFormatConditions)
    On Error GoTo 0
 
    If Not rngAll Is Nothing Then
        i = 1
        For Each rng In rngAll
            Set rngSel1 = rng.SpecialCells(xlCellTypeSameFormatConditions)
            str = rngSel1.Address
            bln = False
            For Each rngSel2 In col
                If str = rngSel2.Address Then
                    bln = True
                    Exit For
                End If
            Next
            If Not bln Then
                col.Add Item:=rngSel1, Key:=cKey & " " & i
                i = i + 1
            End If
        Next
 
        With lvwAddress
            .ColumnHeaders.Add Text:="Address", Width:=.Width - 17
            .View = lvwReport
            .FullRowSelect = True
            .HideSelection = False
            .LabelEdit = lvwManual
 
            For i = 1 To col.Count
                .ListItems.Add Text:=col(i).Address(False, False), Key:=cKey & " " & i
            Next
 
            .Sorted = True
        End With
    End If
End Sub
 
Private Sub lvwAddress_ItemClick(ByVal Item As MSComctlLib.ListItem)
    col(lvwAddress.SelectedItem.Key).Select
End Sub
 
Private Sub lvwAddress_DblClick()
    Application.Dialogs(xlDialogConditionalFormatting).Show
End Sub

You would run the userform with this statement:

Userform1.Show

It's interesting to note that some simple tweaks to the above code would provide you the same management of Data Validations:
1. Change the value for the Const cCaption
2. Change xlCellTypeAllFormatConditions to xlCellTypeAllValidation
3. Change xlCellTypeSameFormatConditions to xlCellTypeSameValidation
4. Change xlDialogConditionalFormatting to xlDialogDataValidation