How to return a range of cells in VBA without using a loop?

Question

Hi,

let's say I have a excel spread sheet like below:

col1   col2
------------
dog1   dog
dog2   dog
dog3   dog
dog4   dog
cat1   cat
cat2   cat
cat3   cat

I want to return a range of cells (dog1,dog2,dog3,dog4) or (cat1,cat2,cat3) based on either "dog" or "cat"

I know I can do a loop to check one by one, but is there any other method in VBA so I can "filter" the result in one shot?

maybe the Range.Find(XXX) can help, but I only see examples for just one cell not a range of cells.

Please advice

Regards

Answer 1

This guy has a nice FindAll function:

http://www.cpearson.com/excel/findall.aspx

Answer 2

Thanks DJ.

That FindAll solution still uses a VBA loop to do things.

I'm trying to find a way without using user level loop to filter a range in excel VBA.

Here I found a solution. it takes advantage of excel built-in engine to do the job.

(1) use worksheetfunction.CountIf(,"Cat") to get the count of "cat" cells

(2) use .Find("cat") to get the first row of "cat"

with the count of rows and the first row, I can get the "cat" range already.

The good part of this solution is: no user-level loop, this might improve the performance if the range is big.

Answer 3

Excel supports the ODBC protocol. I know that you can connect to an Excel spreadsheet from an Access database and query it. I haven't done it, but perhaps there is a way to query the spreadsheet using ODBC from inside Excel.

Answer 4

Unless you're using a veeeery old machine, or you have an XL2007 worksheet with a bazillion rows, a loop is going to be fast enough. Honest!

Don't trust me? Look at this. I filled a million-row range with random letters using this:

=CHAR(RANDBETWEEN(65,90))

Then I wrote this function and called it from a 26-cell range using Control-Shift-Enter:

=TRANSPOSE(UniqueChars(A1:A1000000))

Here's the not-very-optimised VBA function I hacked out in a couple of minutes:

Option Explicit

Public Function UniqueChars(rng As Range)

Dim dict As New Dictionary
Dim vals
Dim row As Long
Dim started As Single

    started = Timer

    vals = rng.Value2

    For row = LBound(vals, 1) To UBound(vals, 1)
        If dict.Exists(vals(row, 1)) Then
        Else
            dict.Add vals(row, 1), vals(row, 1)
        End If
    Next

    UniqueChars = dict.Items

    Debug.Print Timer - started

End Function

On my year-old Core 2 Duo T7300 (2GHz) laptop it took 0.58 sec.

Answer 5

Forgot another XL2007 feature: advanced filtering. If you want it in VBA, I got this from a recorded macro:

Range("A1:A1000000").AdvancedFilter Action:=xlFilterCopy, CopyToRange:= Range("F1"), Unique:=True

I timed it at about 0.35 sec...

Admittedly, not much use if you don't have 2007.

Answer 6

Here are some notes on using a recordset to return the range.

Sub GetRange()
Dim cn As Object
Dim rs As Object
Dim strcn, strFile, strPos1, strPos2

    Set cn = CreateObject("ADODB.Connection")
    Set rs = CreateObject("ADODB.Recordset")

    strFile = ActiveWorkbook.FullName

    strcn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" _
    & strFile & ";Extended Properties='Excel 8.0;HDR=Yes;IMEX=1';"

    cn.Open strcn

    rs.Open "SELECT * FROM [Sheet1$]", cn, 3 'adOpenStatic'

    rs.Find "Col2='cat'"
    strPos1 = rs.AbsolutePosition + 1
    rs.MoveLast
    If Trim(rs!Col2 & "") <> "cat" Then
        rs.Find "Col2='cat'", , -1 'adSearchBackward'
        strPos2 = rs.AbsolutePosition + 1
    Else
        strPos2 = rs.AbsolutePosition + 1
    End If
    Range("A" & strPos1, "B" & strPos2).Select
End Sub