Format Function - Comments Please

[parry]

Hi all, Im just wanting some feedback on an approach to a solution. Many people ask about doing calculations on cells based upon cell format. You can use the old Excel4 macro functions but I wanted to develop my own UDF.

What I have come up with is a function to return a range based upon a desired format. By returning a range you can then use this with any other function such as Sum, Average etc.

The following function called FormatRng has 3 arguments...
Argument 1 = Range to look at
Argument 2 = A single cell to compare against the first argument
Argument 3 = A number representing the type of comparison required. The numbers are:
0 = Compare Interior Colour
1 = Compare Bold Font
2 = Compare Italics
3 = Compare Font Size
4 = Compare Font Colour
5 = Compare Font Name (Arial, Times New Roman etc)
6 = Compare Underline

Example:
I want sum the cells that are bold. The target range is A1:A10 and I have a criteria cell of B1. First you bold cell B1 then enter the following formula into a cell.

=SUM(formatrng(A1:A10,B1,1))

If there are no cells that match cell B1 for a bold font then a #Value error is returned. If you wish to do the opposite of this (ie Sum cells that arent bold, you use the same formula but remove the bold from cell B1. So I am effectively using the comparison cell as a true/false except in the case of colours where it returns cells that match the colour (including no colour).

Does any one have thoughts on this approach and if it can be done a better way? Ideally you wouldnt need the 3rd argument but that would mean checking many criteria and would probably slow things down to an unacceptable level.

Public Function FormatRng(Target As Range, Criteria As Range, i As Integer) As Range
Dim c As Range, Rng As Range

If Criteria.Cells.Count <> 1 Then Exit Function
Application.Volatile

Select Case i
Case 0 'Interior Colour
    For Each c In Target
        If c.Interior.ColorIndex = Criteria.Interior.ColorIndex Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
Case 1 'Font = Bold
    For Each c In Target
        If c.Font.Bold = Criteria.Font.Bold Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
Case 2 'Font = Italics
    For Each c In Target
        If c.Font.Italic = Criteria.Font.Italic Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
Case 3 'Font Size
    For Each c In Target
        If c.Font.Size = Criteria.Font.Size Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
Case 4 'Font Colour
    For Each c In Target
        If c.Font.ColorIndex = Criteria.Font.ColorIndex Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
Case 5 'Font Name
    For Each c In Target
        If c.Font.Name = Criteria.Font.Name Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
Case 6 'Font Underline
    For Each c In Target
        If c.Font.Underline = Criteria.Font.Underline Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
End Select

Set FormatRng = Rng
End Function

 

[HalfAce]

Hi parry,
I’m afraid that at my lowly level on the Excel user’s food chain I’m ill equipped to offer any advice, but I can say you’re onto something cool here. It works beautifully for me and I really like it. Good work.
Dan

 

[Juan Pablo González]

First...

Set Target = Intersect(Target, Target.Parent.UsedRange)

Second, I would put the For Each outside.... also, to "clean" it up a little bit you could use the CallByName method

<font face=Courier New>
<SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Function</SPAN> FormatRng(<SPAN style="color:#00007F">ByVal</SPAN> Target <SPAN style="color:#00007F">As</SPAN> Range, <SPAN style="color:#00007F">ByVal</SPAN> Criteria <SPAN style="color:#00007F">As</SPAN> Range, i <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Integer</SPAN>) <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#00007F">Dim</SPAN> c <SPAN style="color:#00007F">As</SPAN> Range, Rng <SPAN style="color:#00007F">As</SPAN> Range
<SPAN style="color:#00007F">Dim</SPAN> Crit <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Variant</SPAN>
<SPAN style="color:#00007F">Dim</SPAN> Add <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Boolean</SPAN>

<SPAN style="color:#00007F">If</SPAN> Criteria.Cells.Count <> 1 <SPAN style="color:#00007F">Then</SPAN> <SPAN style="color:#00007F">Exit</SPAN> <SPAN style="color:#00007F">Function</SPAN>
Application.Volatile

<SPAN style="color:#00007F">Set</SPAN> Target = Intersect(Target, Target.Parent.UsedRange)
<SPAN style="color:#00007F">If</SPAN> i = 0 <SPAN style="color:#00007F">Then</SPAN>
    Crit = Criteria.Interior.Color
<SPAN style="color:#00007F">Else</SPAN>
    Crit = CallByName(Criteria.Font, Choose(i, "Bold", "Italic", "Size", "Color", "Name", "Underline"), VbGet)
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>

<SPAN style="color:#00007F">For</SPAN> <SPAN style="color:#00007F">Each</SPAN> c <SPAN style="color:#00007F">In</SPAN> Target
    Add = <SPAN style="color:#00007F">False</SPAN>
    <SPAN style="color:#00007F">If</SPAN> i = 0 <SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">If</SPAN> c.Interior.Color = Crit <SPAN style="color:#00007F">Then</SPAN>
            Add = <SPAN style="color:#00007F">True</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">Else</SPAN>
        <SPAN style="color:#00007F">If</SPAN> CallByName(c.Font, Choose(i, "Bold", "Italic", "Size", "Color", "Name", "Underline"), VbGet) = Crit <SPAN style="color:#00007F">Then</SPAN>
            Add = <SPAN style="color:#00007F">True</SPAN>
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">If</SPAN> Add <SPAN style="color:#00007F">Then</SPAN>
        <SPAN style="color:#00007F">If</SPAN> Rng <SPAN style="color:#00007F">Is</SPAN> <SPAN style="color:#00007F">Nothing</SPAN> <SPAN style="color:#00007F">Then</SPAN>
            <SPAN style="color:#00007F">Set</SPAN> Rng = c
        <SPAN style="color:#00007F">Else</SPAN>
            <SPAN style="color:#00007F">Set</SPAN> Rng = Union(Rng, c)
        <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">If</SPAN>
<SPAN style="color:#00007F">Next</SPAN> c
<SPAN style="color:#00007F">Set</SPAN> FormatRng = Rng
<SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Function</SPAN>
</FONT>

 

[parry]

Thanks.

Theres a function found in xl2002 onwards to find format which would be the business as you could then just have a comparison cell without the 3rd argument and it would be pretty quick as it only needs to loop through found cells to build the range rather than every cell in the range. Unfortunately I only have Xl2000 at work so I wanted something that worked in earlier versions.

 

[parry]

Sweet thanks Juan! What a cool function CallByName is - I had never heard of it before.

 

[Juan Pablo González]

Yep, it's pretty cool... Chip Pearson makes some cool use of it here:

http://www.cpearson.com/excel/GetInfo.htm

 

[dk]

Nice work mate

Here are a few ideas:-

<ul>
[*]Change the 'i' to something more meaningful. I entered the function using the function wizard and had to go back to your post to see what 'i' should be.
[*]Declare the comparison type variable as long, not integer. This speeds up the function by approximately 15%.
[*]I think it would be cool if you could specify non-contiguous ranges. This would slow down the code as you'd need to loop through each item in the ParamArray, although the test I've done shows it only slows by about 10%.
[/list]

This is what I ended up with:-

Public Function FormatRng(ByVal Criteria As Range, ByVal ComparisonType As Long, ParamArray Target() As Variant) As Range
    Dim c As Range, Rng As Range
    Dim Crit As Variant
    Dim Add As Boolean
    Dim vItem As Variant
    Dim rngTarget As Range

    If Criteria.Cells.Count <> 1 Then Exit Function
    Application.Volatile

    For Each vItem In Target

        If rngTarget Is Nothing Then
            Set rngTarget = vItem
        Else
            Set rngTarget = Application.Union(rngTarget, vItem)
        End If
    Next vItem

    Set rngTarget = Application.Intersect(rngTarget, rngTarget.Parent.UsedRange)


    If ComparisonType = 0 Then
        Crit = Criteria.Interior.Color
    Else
        Crit = CallByName(Criteria.Font, Choose(ComparisonType, "Bold", "Italic", "Size", "Color", "Name", "Underline"), VbGet)
    End If

    For Each c In rngTarget.Cells
        Add = False
        If ComparisonType = 0 Then
            If c.Interior.Color = Crit Then
                Add = True
            End If
        Else
            If CallByName(c.Font, Choose(ComparisonType, "Bold", "Italic", "Size", "Color", "Name", "Underline"), VbGet) = Crit Then
                Add = True
            End If
        End If
        If Add Then
            If Rng Is Nothing Then
                Set Rng = c
            Else
                Set Rng = Union(Rng, c)
            End If
        End If
    Next c
    Set FormatRng = Rng
End Function

 

[parry]

A nice addition, thanks very much Dan. I havent used Parameter arrays before and now know how to cope with an indefinite number of arguments. VBA help wasnt overflowing with info but I think I understand it.

What Im unclear on is why the use of long would make much difference. I thought an integer was 2 bytes & long was 4 bytes and since long takes marginally more memory & there are only 7 possible numbers then why such a difference? I would have thought that integer was faster.

 

[dk]

http://msdn.microsoft.com/library/d...-us/modcore/html/deconTheIntegerDataTypes.asp

I'm confident to say that one should never need to use integers.

Dan

 

[parry]

mmm
Q: When is a 2 byte Integer 4 bytes?
A: When its coded by MS.

Did you try Byte and see how quick that is in comparison?