Search and copy macro

[jameshunt83]

I have a worksheet called "1.xlsx". I have an active x form button on this sheet.
When this button is clicked I need it to open a second workbook called "2.xlsx". In cell A1 of "1.xlsx" I have a value. I need the macro to look which line in "2.xlsx" this value appears in column A and then copy the value in column B of this to "1.xlsx" cell A2 and also copy the value on that row in column C to "1.xlsx" cell A6.

The value in A1 will only appear on one line in the second workbook

Help greatly appreciated!

 

[jameshunt83]

Anyone?

 

[Colton]

File Location will need to be changed (Highlighted in Red).
Your filename (1.xlsx) will need to be changed to 1.xlsm when code is added.

Private Sub CommandButton1_Click()

    Dim Rng1 As Range, Rng2 As Range, Rng3 As Range, rSearch As Range
    Dim RowFind As Long
    Dim Lookup As Variant

    Application.ScreenUpdating = False

    Workbooks.Open Filename:="[COLOR="Red"]C:\2.xlsx[/COLOR]"

    Set Rng1 = Workbooks("2.xlsx").Worksheets("Sheet1").Range("A:A")
    Set Rng2 = Workbooks("1.[COLOR="Red"]xlsm[/COLOR]").Worksheets("Sheet1").Range("A2")
    Set Rng3 = Workbooks("1.[COLOR="red"]xlsm[/COLOR]").Worksheets("Sheet1").Range("A6")

    Lookup = Workbooks("1.[COLOR="Red"]xlsm[/COLOR]").Worksheets("Sheet1").Range("A1").Value

    Set rSearch = Rng1.Find(What:=Lookup, After:=Range("A1"), _
                            LookIn:=xlValues, LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)

    If rSearch Is Nothing Then
        
        MsgBox ("No Match Found")
        Workbooks("2.xlsx").Close
        Application.ScreenUpdating = True
        Exit Sub
    
    End If

    Rng2.Value = rSearch.Offset(, 1).Value
    Rng3.Value = rSearch.Offset(, 2).Value

    Workbooks("2.xlsx").Close

    Application.ScreenUpdating = True

End Sub

 

[Excelnoobisme]

Sub Testing()

dim wb1, wb2 as workbook
set wb1 = activeworkbook
Workbooks.Open Filename:="C:\2.xlsx"

set wb2 = activeworkbook

Dim ff As Range
Set ff = wb2.Sheets("sheets1").Columns("A").Find(what:=wb1.Sheets("sheet1").Range("A1").Value, LookIn:=xlValues, lookat:=xlWhole)

If ff Is Nothing Then
MsgBox "Not found"
Else

wb2.sheets("sheet1").Range(ff.Address).Offset(0, 1).copy
wb1.sheets("sheet1").range("a2").PasteSpecial Paste:=xlPasteValues

wb2.sheets("sheet1").Range(ff.Address).Offset(0, 2).copy
wb1.sheets("sheet1").range("a6").PasteSpecial Paste:=xlPasteValues


End If

ActiveWorkbook.Save
ActiveWindow.Close

End Sub