retriving specific data?????

W

wt.pm

I have a worksheet set up as an address book, is there a way to be able to
type in a name in a specific cell, and automatically have that persons
information pulled up to the top of the screen. I use this at work, and have
over 200 names, which I call regularly, and searching through to find it,
then having to hold my finger on the screen while calling is getting old. I
do have the names seperated as much as possible, but it is still a big list.
If you go to start>search> type in a file, it get's pulled to the top of
the search page. This is similar to what I am trying to do.
 
W

wt.pm

Thank you for the help, this will work for what I want. However, what I was
hoping for was to be able to type a last name, then have everyone with that
last name, to be pulled up. I don't want to copy to another location, neither
do I want to have to type a whole formula each time. I would like to set up
one "empty" cell, that has a function, filter or what ever attached, so that
when I type the name "Smith", all 8 people with that name are shown. As it
is, only one person is pulled up. Which is fine, I am happy with this, but
the other would work better.
 
R

ryguy7272

Ok, right click the sheet that you want to filter on. Clik 'View Code' and
paste this code into the window that opens:

Option Explicit

'---------------------------------------------------------------------------------------
' Procedure : Worksheet_Change
' Author : Roger Govier, Technology 4 U
' Date : 09-Mar-2008
' Purpose :To enable filtering without having to use the dropdown arrows
' :Especially useful in XL2007 where you need to deselect
all before making
' :a selection. Also save the need to invoke the Custom
dialogue
' :Highlighting of cells with the criteria allows easy view
of what selections have been made.
' :The code was inspired by a discussion with Dr Peter
Grebenik, Brookes University
' :Oxford, who had used something similar in his work.
'---------------------------------------------------------------------------------------
'
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rownum As Long, colnum As Long
Dim tblname As String, mylist As Object
Dim caret As Long, caret2 As Long
Dim crit1 As String, crit2 As String, optype As String, marker As String

'Set this next value to the row number above your filter
Const testrow = 1
'Change the marker to something other than the caret ^ if required
marker = "^"

On Error GoTo Worksheet_Change_Error

rownum = Target.Row
colnum = Target.Column
On Error Resume Next

If Target.Count > 1 Then
ActiveSheet.ShowAllData
Target.Interior.ColorIndex = -4142 'clear colour from range
GoTo cleanup
End If

If rownum <> testrow Then GoTo cleanup
crit1 = Target.Value
caret = InStr(Target, marker)
caret2 = InStr(Target, marker & marker)

If caret Then
crit1 = Trim(Left(Target.Value, caret - 1))
crit2 = WorksheetFunction.Substitute(Mid(Target.Value, caret + 1), marker, "")
optype = xlAnd
End If

If caret2 Then
optype = xlOr
End If

If Val(Application.Version) < 11 Then GoTo earlyversion

Set mylist = ActiveSheet.ListObjects
If mylist.Count Then ' A List or Table Object is used
tblname = mylist(1).Name

If Cells(rownum, colnum).Value = "" Then ' No filter choice
mylist(tblname).Range.AutoFilter Field:=colnum
GoTo cleanup
ElseIf caret Then
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
GoTo cleanup
Else
mylist(tblname).Range.AutoFilter Field:=colnum, _
Criteria1:=crit1
GoTo cleanup
End If

' There is no List object, it is a Range so treat the same as
' earlier versions of Excel

End If

earlyversion:
'This version of Excel does not support List Objects
If Cells(rownum, colnum).Value = "" Then
Selection.AutoFilter Field:=colnum
ElseIf caret Then
Selection.AutoFilter Field:=colnum, _
Criteria1:=crit1, Operator:=optype, Criteria2:=crit2
Else
Selection.AutoFilter Field:=colnum, Criteria1:=crit1
End If

cleanup:
'keep focus on same cell and set colour index if Selection is made
Range(Target.Address).Activate
If ActiveCell <> "" Then
ActiveCell.Interior.ColorIndex = 40 'change to colour of your choice
Else
ActiveCell.Interior.ColorIndex = -4142
End If


On Error GoTo 0
Exit Sub

Worksheet_Change_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure
Worksheet_Change of VBA Document Sheet4"
ActiveCell.Interior.ColorIndex = -4142
On Error GoTo 0
End Sub

Put your data on Row 3 (and below).

HTH,
Ryan---
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top