LOOK UP VALUE(S) IN ANOTHER WORKSHEET (SOLVED)

'=========================================================
'- GENERIC LOOKUP MACRO TO
'- FIND A VALUE IN ANOTHER WORKSHEET
'- AND RETURN A VALUE FROM ANOTHER COLUMN
'=========================================================
'- select the cell containing the first search value
'- and run this macro from there.
'- can be set to continue down the column
'- [** need to make changes below as required **]
'- Brian Baulsom  May 2005
'==========================================================
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                     [**AMEND AS REQUIRED**]
    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 [**AMEND AS REQUIRED**]
    ReturnColumnNumber = 2    ' 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
'=========================================================================

'==================================================================== 
'- MACRO TO FIND A VALUE AND PUT RESULTS INTO A USERFORM LISTBOX 
'- THIS ListBox HAS 3 COLUMNS 
'- Put subroutine into a normal sub xx () with code "UserForm1.Show" 
'- Brian Baulsom May 2006 
'==================================================================== 
'- THIS CODE SHOULD GO INTO A USERFORM MODULE 
'- The userform requires 
'-     1. TextBox1 for find value entry. 
'-     2. ListBox1. There is code below to set column count & widths. 
'-     3. CheckBox1 to define exact or partial match 
'-     4. Label1 to show number of items found 
'-     5. CommandButton1 to run the macro. 
'-     6. CommandButton to exit and unload the form 
'==================================================================== 

'========================================================================= 
'- MAIN ROUTINE 
'========================================================================= 
Private Sub CommandButton1_Click() 
    Dim MyInput As Variant 
    Dim FoundRow As Long 
    Dim ListEndRow As Integer 
    Dim ws As Worksheet 
    Dim FoundCell As Object 
    Dim LastRow As Long 
    '--------------------------------------------------------------------- 
    Set ws = ActiveSheet 
    LastRow = ws.Range("A65536").End(xlUp).Row 
    ListBox1.Clear 'clear the listbox 
    ListEndRow = 0 
    '---------------------------------------------------------------------- 
    '- SET LISTBOX COLUMN COUNT & WIDTHS in Points (=1/72 inch) 
    ListBox1.ColumnCount = 3 
    ListBox1.ColumnWidths = "20;40;40" 
    '---------------------------------------------------------------------- 
    '- input 
    '- convert to correct data type 
    '- may not really be necessary, but to be safer .... 
    MyInput = Me.TextBox1.Text   ' NB. Textbox output is always text 
    If IsNumeric(MyInput) Then 
        MyInput = CDbl(MyInput) 
    Else 
        MyInput = CStr(MyInput) 
    End If 
    '----------------------------------------------------------------------- 
    '- LOOK FOR VALUES IN COLUMN A down to last row containing data 
    With ws.Range("A1:A" & LastRow) 
        '------------------------------------------------------------------- 
        '- EXACT OR PARTIAL MATCH FROM CHECKBOX 
        If CheckBox1.Value = True Then 
            Set FoundCell = .Find(MyInput, LookIn:=xlValues, lookat:=xlWhole) 
        Else 
            Set FoundCell = .Find(MyInput, LookIn:=xlValues, lookat:=xlPart) 
        End If 
        '------------------------------------------------------------------ 
        '- FIND 
        If FoundCell Is Nothing Then 
                ListBox1.ColumnWidths = "50;0;0" 
                ListBox1.AddItem 
                ListBox1.List(ListEndRow, 0) = "No Match Found" 
        Else 
            FirstAddress = FoundCell.Address 
            Do 
                FoundRow = FoundCell.Row 
                ListBox1.AddItem 
                ListBox1.List(ListEndRow, 0) = ws.Cells(FoundRow, 1).Value 
                ListBox1.List(ListEndRow, 1) = ws.Cells(FoundRow, 2).Value 
                ListBox1.List(ListEndRow, 2) = ws.Cells(FoundRow, 3).Value 
                ListEndRow = ListEndRow + 1 
                Set FoundCell = .FindNext(FoundCell) 
            Loop While Not FoundCell Is Nothing And FoundCell.Address <> FirstAddress 
        End If 
    End With 
    Label1.Caption = "Found " & vbCr & ListEndRow & " match" & IIf(ListEndRow = 1, "", "es") 
    TextBox1.SetFocus 
    SendKeys "{HOME}" & "+{END}"    ' to select textbox contents 
End Sub 
'------------------------------------------------------------------------------ 
Private Sub CommandButton2_Click() 
    Unload Me 
End Sub 
'------------------------------------------------------------------------------ 
Private Sub UserForm_Initialize() 
    TextBox1.SetFocus 
End Sub 
'------------------------------------------------------------------------------