Excel VBA Vlookup

[mack22]

Hi Guys
I am wanting to copy rows of data from one workbook to another based on a value.

Workbook1 has a list of car parts from vehicles/stock no
[TABLE="width: 500"]
<tbody>[TR]
[TD]stock no[/TD]
[TD]model name[/TD]
[TD]year model[/TD]
[TD]part name[/TD]
[/TR]
[TR]
[TD]a005013[/TD]
[TD]911[/TD]
[TD]2003[/TD]
[TD]rear spoiler[/TD]
[/TR]
[TR]
[TD]a005013[/TD]
[TD]911[/TD]
[TD]2003[/TD]
[TD]wiper motor[/TD]
[/TR]
[TR]
[TD]a005055[/TD]
[TD]911[/TD]
[TD]2005[/TD]
[TD]drivers airbag[/TD]
[/TR]
[TR]
[TD]a005055[/TD]
[TD]911[/TD]
[TD]2005[/TD]
[TD]driveshaft[/TD]
[/TR]
</tbody>[/TABLE]

Workbook2 needs to lookup the parts from workbook1 and copy the rows into workbook2 using a command button based on the stock no
so if stock no a005055 was entered it would copy 2 rows into workbook2.

Hope this makes!!
Many thanks

 

[My Aswer Is This]

You provided no specific details so I can provide this:

This script assumes you sheet names are:
Copy from Workbook is named OneOne.xlsm
Copy to Workbook is named TwoTwo.xlsm

And both sheets are Sheet(1)

And we will be searching column A of Workbook OneOne sheet(1)

And this script needs to be installed in Workbook TwoTwo and run from sheet(1) of Workbook TwoTwo

Sub Filter_Me()
'Modified 6/19/2018 1:50 AM  EDT
Application.ScreenUpdating = False
Dim ans As String
Dim Lastrow As Long
Dim Lastrowa As Long
Dim c As Long
Dim s As Variant
Dim CF As String
Dim CT As String
CF = "OneOne.xlsm"  'Change Workbook name here
CT = "TwoTwo.xlsm" 'Change Workbook name here
ans = InputBox("Enter part number to search for")
Lastrow = Workbooks(CF).Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
Lastrowa = Workbooks(CT).Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row + 1
c = "1"
s = ans
With Workbooks(CF).Sheets(1).Cells(1, c).Resize(Lastrow)
    .AutoFilter 1, s
    counter = .Columns(c).SpecialCells(xlCellTypeVisible).Count
    If counter > 1 Then
        .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Copy Workbooks(CT).Sheets(1).Rows(Lastrowa)
    Else
        MsgBox "No values found"
    End If
    .AutoFilter
End With
Application.ScreenUpdating = True
End Sub

You will see I have made it so you can modify the Workbook names.


Be aware both Workbooks must be open.

 

[mack22]

Thanks for posting but I get a Script out of range error any thoughts?

 

[My Aswer Is This]

There could be a lot of reasons.
Did you modify the workbook names?
Are we dealing with sheet(1) on both workbooks?

Have both workbooks been saved so there names have the xlsm extension.

You may need to give me the specifics of all your two workbook names and the sheet names

Show me the modified script your now using. With proper Workbook and sheet names.

Are both workbooks open?

 

[mack22]

it was the file extension as soon as I changed it to xlsm it worked. Just one more thing can we have a command button to action this.
Many thanks

 

[My Aswer Is This]

How are you running the script now?

 

[My Aswer Is This]

I make my command buttons by inserting a shape.
Look on Ribbon: Shapes Insert

Choose some shape put it where you want:

And this script needs to be installed in Workbook TwoTwo and run from sheet(1) of Workbook TwoTwo​

So insert the shape on this sheet.
Right click on the shape and choose Assign Macro.
And choose your macro.

Then when you click the shape the script should run.

 

[My Aswer Is This]

Or from the Ribbon:
Choose Developer
Choose Insert
Choose Form Control Command Button
Right click some place on your sheet.
Choose the macro from the list.
Now when you click on the Command Button your script will run.
Shape Button the size you want. Right click Button to change name and other properties
I like shapes because I can make shape the type I want add color Text etc. More options then Command Buttons.

 

[mack22]

Worked a treat thanks so much for your help!!

 

[My Aswer Is This]

Glad I was able to help you.
Come back here to Mr. Excel next time you need additional assistance.

Worked a treat thanks so much for your help!!