Search name in column when found copying name and row data

tlceph415

New Member
Joined
Nov 10, 2005
Messages
8
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
 

Some videos you may like

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

tlceph415

New Member
Joined
Nov 10, 2005
Messages
8
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

Well-known Member
Joined
Feb 17, 2003
Messages
8,127
You need to say at which line of code the error occurs (click Debug at the error message). I guess it is this one.
Code:
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,118,324
Messages
5,571,551
Members
412,403
Latest member
Iggvsbsb
Top