'-------------------------------------------------------------------------------
' Module : UserDefinedFunctions
' Author : Aaron Bush
' Date : 05/30/2008
' Purpose : Contains Functions intended to be available to user in
' Microsoft Excel.
' References : Visual Basic For Applications
' C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\
' VBE6.DLL
' Microsoft Excel 11.0 Object Library
' C:\Program Files\Microsoft Office\OFFICE11\EXCEL.EXE
' Dependancies : None
'-------------------------------------------------------------------------------
Option Explicit
Option Compare Binary
Option Base 0
'Option Public Module
'Setting this to True will turn off all error handling:
#Const m_blnErrorHandlersOff_c = False
Public Function SVLOOKUP(ByVal value As String, ByVal lookupTable As _
Excel.Range, Optional ByVal matchCase As Boolean = False) As Variant
'---------------------------------------------------------------------------
' Procedure : SLOOKUP
' Author : Aaron Bush
' Date : 05/30/2008
' Purpose : Simple Lookup. Provides a simpler VLOOKUP syntax by assuming
' the return column is the left column in the range and an
' replaces the esoteric Range Lookup paramter with an
' optional Case-Sensitivity paramter.
' Input(s) : value - The value to be looked up.
' lookupTable - The table that contains the data you want a
' lookup performed on.
' matchCase - Optional. Determines case-sensitivity. Default
' is false.
' Output(s) : If value is encountered in the left-most column of the lookup
' table, the return value will be the value of the same row,
' but the rightmost column of the lookup table. The first value
' encountered is used.
' Remarks : Variant return type used to accomdate excel numbers and
' strings.
' Revisions :
'---------------------------------------------------------------------------
Const strNotFnd_c As String = "#NotFound!"
Const lngLkupClmn_c As Long = 1
Dim wsParnt As Excel.Worksheet
Dim rngLkup As Excel.Range
Dim cll As Excel.Range
Dim varRtnVal As Variant
'Conditionally Invoke Error Handler:
#If Not m_blnErrorHandlersOff_c Then
On Error GoTo Err_Hnd
#End If
Set wsParnt = lookupTable.Parent
Set rngLkup = Excel.Intersect(lookupTable.Columns(lngLkupClmn_c), _
wsParnt.UsedRange)
If matchCase Then
For Each cll In rngLkup.Cells
If cll.value = value Then
varRtnVal = wsParnt.Cells(cll.Row, lookupTable.Column + _
lookupTable.Columns.Count - lngLkupClmn_c).value
Exit For
End If
Next
Else
value = LCase$(value)
For Each cll In rngLkup.Cells
If LCase$(cll.value) = value Then
varRtnVal = wsParnt.Cells(cll.Row, lookupTable.Column + _
lookupTable.Columns.Count - lngLkupClmn_c).value
Exit For
End If
Next
End If
If cll Is Nothing Then
varRtnVal = strNotFnd_c
End If
'******* Exit Procedure *******
Exit_Proc:
'Supress Error Handling to Prevent Error-Loops:
On Error Resume Next
'Release Objects:
Set wsParnt = Nothing
Set rngLkup = Nothing
'Set Return Value:
SVLOOKUP = varRtnVal
Exit Function
'******* Error Handler *******
Err_Hnd:
varRtnVal = Err.Description
Resume Exit_Proc
End Function
It could be optimized for speed, but this is something that functions the way I was thinking. But to be honest I tend to steer clear of UDFs because people either won't have the add-in you make, or have macro's enabled etc.
