VBA: Limiting cell range with functions

Question

How do you write a function in VBA that lets the user enter a range as a parameter, and set the upper/lower bounds for that range (in case they enter a whole column)?

I have a function that looks at a cell and sees if it contains any words listed in a glossary (I just allow the user to select a column (range) that is the list of glossary terms. I currently use a for each cell in range loop to go through the range, but I don't want to waste steps going through ALL the cells in column A, even if I am checking first if Len(cell.value) <> 0.

I am guessing it's done with a select statement, but I'm now sure how to do that to a range that was passed as a parameter (I call it cell_range right now).

Any help would be greatly appreciated!

Added Info: The data type of the range is of type string. It's a list of English words (glossary terms) and I am writing a function that will look at a cell and see if it includes any of the terms from the glossary. If it does, the code returns the glossary term plus the offset cell to the right (the translated term).

EDIT (06.20.11) Finalized code thanks to experimentation and suggestions below. It takes a cell and looks for any glossary terms in it. It returns the list of terms, plus the translated terms (second column in glossary).

Function FindTerm(ByVal text As String, ByVal term_list As range) As String

Static glossary As Variant
Dim result As String
Dim i As Long

glossary = range(term_list.Cells(1, 1), term_list.Cells(1, 2).End(xlDown))

For i = 1 To UBound(glossary)
    If InStr(text, glossary(i, 1)) <> 0 Then
       result = (glossary(i, 1) & " = ") & (glossary(i, 2) & vbLf) & result
    End If
Next

If result <> vbNullString Then
    result = Left$(result, (Len(result) - 1))
End If

FindTerm = result

End Function

Answer 1

Why not limit your loop to the filled cells efficiently?

For Each c In Range("a:a").SpecialCells(xlCellTypeConstants)
   ....
Next c

Answer 2

To answer the direct question, you can't restrict what is passed as a parameter, but you can derive a new range from a passed range.

That said, looping through a range is very slow. There are may alternative methods:

• Query based methods, as suggested by Remou

• Copy the range to a variant array and loop through that
  Dim vDat as variant
vDat = cell_range
  vDat is now a two dimensional array

• Use the built in search function Find
  cell_range.Find ...

• Use Application.WorksheetFunction.Match (and/or .Index .VLookup)

Which one best suits depend on the specifics of your case

Edit

Demo of the variant array approach

Function Demo(Glossary As Range, search_cell As Range) As String
    Dim aGlossary As Variant
    Dim aSearch() As String
    Dim i As Long, j As Long
    Dim FoundList As New Collection
    Dim result As String
    Dim r As Range
    ' put data into array
    aGlossary = Range(Glossary.Cells(1, 1), Glossary.Cells(1, 1).End(xlDown))

    ' assuming words in search cell are space delimited
    aSearch = Split(search_cell.Value, " ")
    'search for each word from search_cell in Glossary
    For i = LBound(aSearch) To UBound(aSearch)
        For j = LBound(aGlossary, 1) To UBound(aGlossary, 1)
            If aSearch(i) = aGlossary(j, 1) Then
                ' Add to found list
                FoundList.Add aSearch(i), aSearch(i)
                Exit For
            End If
        Next
    Next

    'return list as comma seperated list
    result = ""
    For i = 1 To FoundList.Count
        result = result & "," & FoundList.Item(i)
    Next
    Demo = Mid(result, 2)
End Function

Answer 3

If you are confident there are no gaps:

''Last cell in column A, or first gap
oSheet.Range("a1").End(xlDown).Select

''Or last used cell in sheet - this is not very reliable, but 
''may suit if the sheet is not much edited
Set r1 = .Cells.SpecialCells(xlCellTypeLastCell)

Otherwise, you may need http://support.microsoft.com/kb/142526 to determine the last cell.

EDIT Some notes on selecting the column

Dim r As Range
Dim r1 As Range
Dim r2 As Range
Set r = Application.Selection
Set r1 = r.Cells(1, 1)
r1.Select
Set r2 = r1.End(xlDown)

If r2.Row > Sheet1.Cells.SpecialCells(xlCellTypeLastCell).Row Then
    MsgBox "Problem"
Else
    Debug.Print r1.Address
    Debug.Print r2.Address
End If

Set r = Range(r1, r2)
Debug.Print r.Address

However, you can also use ADO with Excel, but whether it will work for you depends on what you want to do:

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

Dim a As String

''It does not matter if the user has selected a whole column,
''only the data range will be picked up, nor does it matter if the
''user has selected several cells, except when it comes to the HDR
''I guess you could set HDR = Yes or No accordingly.

''One cell is slightly more difficult, but for one cell you would 
''not need anything like this palaver.

a = Replace(Application.Selection.Address, "$", "")

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

strFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used. 
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

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

''Late binding, so no reference is needed

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


cn.Open strCon

''So this is not very interesting:
strSQL = "SELECT * " _
       & "FROM [Sheet1$" & a & "]"

''But with a little work, you could end up with:

strSQL = "SELECT Gloss " _
       & "FROM [Sheet1$A:A] " _
       & "WHERE Gloss Like '%" & WordToFind & "%'"

''It is case sensitive, so you might prefer:

strSQL = "SELECT Gloss " _
       & "FROM [Sheet1$A:A] " _
       & "WHERE UCase(Gloss) Like '%" & UCase(WordToFind) & "%'"

rs.Open strSQL, cn, 3, 3

''Pick a suitable empty worksheet for the results
''if you want to write out the recordset
Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs

''Tidy up
rs.Close
Set rs=Nothing
cn.Close
Set cn=Nothing