Search name in column when found copying name and row data

[tlceph415]

Hello all,

I am building a customer spreadsheet with basic information Name, address, ID number, date of visit, etc.

I want to search for their name from one sheet and when found copy specific data to a form created in excel.

ID # Date First Last
00001 10/12/2005 Cassandra Mcclarin
00002 10/12/2005 Sharon Russ
00003 10/12/2005 Pearl McVae
00004 10/25/2005 Orlencia Martinez
00005 10/25/2005 Jennifer Dilua


Thank you for your help

 

[BrianB]

Hopefully this will help you on your way :-

http://www.mrexcel.com/board2/viewtopic.php?t=149439&highlight=

 

[tlceph415]

Thanks, but still having problems

Thank You Brian, but when I run this Macro I get a Subscript out of range error any thoughts?

Ammendments made in Bold.

I am not that proficent with creating VB codes.

Dim MyValue As Variant
Dim FromSheet As Worksheet
Dim LookupColumn As Integer
Dim FromRow As Long
Dim FromColumn As Integer
'-
Dim ToSheet As Worksheet
Dim StartRow As Long
Dim LastRow As Long
Dim ActiveColumn As Integer
Dim ReturnColumnNumber
Dim ToRow As Long
Dim FoundCell As Object

'=============================================================
'- MAIN ROUTINE
'=============================================================
Sub DO_LOOKUP()
Application.Calculation = xlCalculationManual
'----------------------------------------------------------
'- LOOKUP SHEET [Sheet1]
Set FromSheet = Workbooks("Book1.xls").Worksheets("Sheet1")
LookupColumn = 1 ' look for match here
FromColumn = 2 ' return value from here
'-----------------------------------------------------------
'- ACTIVE SHEET
Set ToSheet = ActiveSheet
ActiveColumn = ActiveCell.Column
StartRow = ActiveCell.Row
'-------------------------------------------------------------
'- COMMENT OUT UNWANTED LINE, UNCOMMENT THE OTHER
'- ..............................[** FOR MULTIPLE ROWS **]
'LastRow = ToSheet.Cells(65536, ActiveColumn).End(xlUp).Row
'-
'- ..............................[** FOR A SINGLE VALUE **]
LastRow = ActiveCell.Row
'-------------------------------------------------------------
'- COLUMN NUMBER TO PUT RETURNED VALUE [Sheet1]
ReturnColumnNumber = 3 ' column number
'-------------------------------------------------------------
'- loop through each row (which may be only 1)
For ToRow = StartRow To LastRow
MyValue = ToSheet.Cells(ToRow, ActiveColumn).Value
FindValue
Next
'-------------------------------------------------------------
'- finish
MsgBox ("Done")
Application.Calculation = xlCalculationAutomatic
End Sub
'== END OF PROCEDURE ====================================================

'========================================================================
'- FIND VALUE
'========================================================================
Private Sub FindValue()
Set FoundCell = _
FromSheet.Columns(LookupColumn).Find(MyValue, LookIn:=xlValues)
If FoundCell Is Nothing Then
MsgBox (MyValue & " not found.")
Else
FromRow = FoundCell.Row
'- transfer additional data.
ToSheet.Cells(ToRow, ReturnColumnNumber).Value = _
FromSheet.Cells(FromRow, FromColumn).Value
End If
End Sub

 

[BrianB]

You need to say at which line of code the error occurs (click Debug at the error message). I guess it is this one.

Set FromSheet = Workbooks("Book1.xls").Worksheets("Sheet1")

1. you need to check the spelling of the workbook/sheet names. Make sure they exist or change the code.
2. you have probably not saved the workbook. Until then it has no name.