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

Question

let's say I have an extended excel sheet as shown 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 "dog" or "cat"

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

Range.Find (XXX) might help, but I only see examples for a single cell, not a range of cells.

I ask for advice

Hello

Answer 1

.

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

Answer 2

FindAll:

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

Answer 3

XL2007: . VBA, :

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

0,35 ...

, , 2007.

Answer 4

DJ.

FindAll - VBA .

excel VBA.

. .

(1)   workheetfunction.CountIf(, "Cat" ), "cat"

(2) .Find( "cat" ), "cat"

, "cat" .

: , , .

Answer 5

Excel ODBC. , Excel Access . , , , , ODBC Excel.

Answer 6

If you are not using an old veeeery machine or if you have a XL2007 worksheet with basillion rows, the cycle will be fast enough. Honestly!

Do not believe me? Look at it. I filled a range of a million lines with random letters using this:

=CHAR(RANDBETWEEN(65,90))

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

=TRANSPOSE(UniqueChars(A1:A1000000))

Here's a not-so-optimized VBA function that I cracked 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 annual 2GHz Core 2 Duo T7300 laptop, it took 0.58 seconds.