Option Explicit
Private Const MACNAME As String = "Data Searcher"
Private Const DATA_NOT_FOUND As Integer = -1
Public Sub DataSearcher()
Dim strFindThis As String
Dim strFindInCol As String
Dim col As Range
Dim lngRowFound As Long
Dim strMsg As String
Dim lngLastRow As Long
Dim strSearchRange As String
On Error Resume Next
'Get search criteria from user
strFindThis = InputBox("Please enter the DATA to search for...", MACNAME)
'eliminate trailing and leading spaces.
strFindThis = Trim$(strFindThis)
'catches user cancel too.
If Len(strFindThis) = 0 Then GoTo NOT_VALID
'Get column where criteria supposedly lives... same sequence as above
strFindInCol = InputBox("Please enter the COLUMN(letter) to search in...", MACNAME)
strFindInCol = Trim$(strFindInCol)
If Len(strFindInCol) = 0 Then GoTo NOT_VALID
'simple validation of column letter.
If IsNumeric(strFindInCol) Then GoTo NOT_VALID
'pet trick... try to create a range object with the col supplied by user.
'if error occurs, column is not valid. Very nifty since there is no built-in
'that converts column letter to column number.
Set col = ActiveSheet.Range(strFindInCol & "1")
If Err.Number <> 0 Then GoTo NOT_VALID
'armed with a column, find the last *used* cell in that column.
'this will be used for...
'1) the range to search
'2) if needed, which ROW to use for additions
lngLastRow = col.SpecialCells(xlCellTypeLastCell).Row
'make a *string* range argument ie B1:B789
strSearchRange = strFindInCol & "1:" & strFindInCol & CStr(lngLastRow)
'the search. Beware the hardcoded "Activesheet"
'If activesheet is not a worksheet (ie chartsheet, macrosheet etc) this WILL fail!
lngRowFound = SimpleSearch(strFindThis, ActiveSheet, strSearchRange)
'process the result of the search
If lngRowFound = DATA_NOT_FOUND Then
strMsg = UCase$(strFindThis) & " was not found." & vbNewLine & vbNewLine
strMsg = strMsg & "Do you want to add " & UCase$(strFindThis) & " to the end of the list?"
Select Case MsgBox(strMsg, vbQuestion + vbYesNo, MACNAME)
Case vbYes
'add the item to last used row+1 of the chosen column
ActiveSheet.Range(strFindInCol & lngLastRow).Offset(1).Value = UCase$(strFindThis)
Case Else
End Select
Else
strMsg = UCase$(strFindThis) & " exists in Row " & CStr(lngRowFound) & "." & vbNewLine & vbNewLine
MsgBox strMsg, vbExclamation, MACNAME
End If
EXIT_PROC:
Set col = Nothing
Exit Sub
NOT_VALID:
strMsg = "Invalid or no input." & vbNewLine & vbNewLine
strMsg = strMsg & "Data: " & strFindThis & vbNewLine
strMsg = strMsg & "Column: " & strFindInCol
MsgBox strMsg, vbExclamation, MACNAME
GoTo EXIT_PROC
End Sub
Public Function SimpleSearch(ByVal strSearchValue As String, ws As Worksheet, strRng As String) As Long
Dim x As Variant
On Error Resume Next
'NOTE: 9/2000 ... Per NG microsoft.public.excel.worksheetfunctions...
' Match is not a member of WorsheetFunction as docs say.
' Furthermore, when used in VBA, variant return must be used.
' Apparantly there is an error with the #NA error Match returns to VBA
x = Application.Match(strSearchValue, ws.Range(strRng), 0)
If IsError(x) Then
SimpleSearch = DATA_NOT_FOUND
Else
SimpleSearch = x
End If
End Function