Search and copy cells between workbooks

[anakaine]

First off, I know that I have seen a few variations of this question on the board, and on google, I just cannot seem to come up with the appropriate script for the job... Any help is greatly appreciated!

The Task:
I have 2 seperate spreadsheets. One is my product list. The other is my suppliers product list. I chose to carry about 1000 of the 20 000 items avaliable to me.
What I need to do, is take row 2 in my own spreadsheet. Look at Column A, row 2. This is my product code for the first item. (Every other code is located in Column A, row 3, row 4, row 5, row 6, etc)

I then need to search the suppliers spreadsheet for that product code in Column A. When I find it, the value I need to copy is in Column G on that row.

Copy the Value from Column G on my suppliers spreadsheet back in to Culumn I on my spreadsheet (on the same row we were initially pulling the code to search for from), overwriting the previous value present.



My Spreadsheet = myprodlist.xls
Suppliers = suppliers.xls


As I said, I have seen similar, but not quite the same. This only requires us to copy a single cell, and I'm totally not familiar with how to search. I tried a simple search script by playing with some others, but just couldn't quite nail it down.

Excel 2003, Windows xp

Thanks again for any help,
Simon

 

[HalfAce]

Hello anakaine. Welcome to the board.
Assuming four things...
1) Both of these lists are on sheet 1 of their respective workbooks.
2) You'll be running this code from the myprodlist workbook.
3) Both of these workbooks will be open when the code runs.
4) You don't already have a sheet in the myprodlist workbook named "TempSheet"

Public Sub Demo()
Dim fCell As Range, supRng As Range
Dim cell As Range, prodRng As Range
Application.ScreenUpdating = False

Sheets.Add.Name = "TempSheet"
Workbooks("suppliers.xls").Sheets("Sheet1").Cells.Copy _
    Workbooks("myprodlist.xls").Sheets("TempSheet").Range("A1")
    
Set supRng = Worksheets("TempSheet").Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))
Sheets("Sheet1").Activate
Set prodRng = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp))

For Each cell In prodRng
    Set fCell = supRng.Find(What:=cell, After:=[A1], LookIn:=xlFormulas, LookAt:=xlWhole, _
        SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
    If Not fCell Is Nothing Then cell.Offset(, 8).Value = fCell.Offset(, 6).Value
Next cell

Application.DisplayAlerts = False
Sheets("TempSheet").Delete
With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With
End Sub

That help any?

 

[anakaine]

I'll give it a run later on tonight.

The four assumptions are correct, so, it shouldn't be a problem.


Thanks very much!

 

[HalfAce]

Most welcome.

I'll check back in the morning & see how it went.

 

[anakaine]

Mate, you are a champion!

Awesome work, thankyou very much.

I do have one further query, and something that has only arisen just now that I've noticed my supplier doesnt list RRP prices on all items.

How would I modify the script so that if when it finds the search string in the suppliers.xls workbook it can determine if the price colum (column G I think it was...) has a price other than 0.00 or nothing in it?

If / Then loop I'm sure. I'm just not entirely sure how to check the value of a cell

 

[HalfAce]

How would I modify the script so that if when it finds the search string in the suppliers.xls workbook it can determine if the price colum (column G I think it was...) has a price other than 0.00 or nothing in it?

Thanks for the kind words.
You didn't specify what you want to have happen if the value is 0.00 or nothing, so here's an example that just doesn't copy those values to the myprodlist WB.

All I did was amend the line:
If Not fCell Is Nothing Then
to this:
If Not fCell Is Nothing And fCell.Offset(, 6) > 0 Then

That help?

 

[anakaine]

Righto. Thanks!