Find a values in workbook2 and copy offset value to workbook1

Question

(New to scrip writing) I am working on a BOM to add cost informatioin for parts from another spreadsheet and add it to my BOM spreadsheet. The code I have works fine until the part number is not found. Then I get the Object variable ..not set.

Sub Costin()

Dim Partno
Dim LastcRow
Dim Rowno

LastcRow = Range("B" & Rows.Count).End(xlUp).Row
LastccRow = Range("A" & Rows.Count).End(xlUp).Row

Rowno = 4

Workbooks("cost_bom.txt").Activate
Worksheets("cost_bom").Select

' GET FIRST PART NUMBER
Range("b4").Select
Partno = ActiveCell.Value

' FIND COST OF ACTIVE PART
For Rowno = 4 To LastcRow
    Windows("Comp-cost.xlsx").Activate
    Columns("A").Select

    Selection.Find(what:=Partno, After:=ActiveCell, LookIn:=xlFormulas _
      , Lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
      MatchCase:=False, SearchFormat:=False).Activate

' >> Gives Object error on start if not commented out
  '  If Partno Is Nothing Then
  '    Windows("COST_BOM.txt").Activate
  '    ActiveCell.Offset(0, 5).Select
  '    ActiveCell.Value = "$$$$"
  '    Else
  '  End If

    ActiveCell.Offset(0, 1).Select
    Cost = ActiveCell.Value

' COPY COST TO BOM
    Application.CutCopyMode = False
    Selection.Copy
    Windows("COST_BOM.txt").Activate
    ActiveCell.Offset(0, 5).Select
    Application.CutCopyMode = False
    ActiveCell.Value = Cost
    Cells(Rowno, 2).Select
    Partno = ActiveCell.Value
Next Rowno


End Sub

I tried to change the code to not use select and activate. It runs through and fills the cells but instead of the value it returns #N/A I want it to look at all values (part Numbers) from column B4 to end in the first workbook and find the same value in another workbook and return the adjacent cell value (Cost) to the first workbook. This is part of a larger module which pulls the info from a CAD program and creates the BOM

I can't figure out what the search is looking at.

Dim C As Integer, n As Integer
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rngLookup As Range
Dim v

Application.ScreenUpdating = True

Set wb1 = Workbooks("cost_bom.txt")
Set ws1 = wb1.Sheets("cost_bom")
ws1.Range("g4:g100000").ClearContents
Set wb2 = Workbooks("comp-price.xlsx")

With wb2.Sheets("Sheet1")
Set rngLookup = .Range(.Cells(2, 1), .Cells(2, 2).End(xlDown)).Resize(, 3)


End With

With ws1
    C = 4
    Do Until .Cells(C, 2) = ""
    v = Application.VLookup(.Cells(C, 2).Value, rngLookup, 2, False)
        ' If Not IsError(v) Then
    .Cells(C, 7).Value = v
    C = C + 1
    Loop
End With

Just guessing here but does anything change if you say `If Partno = "" Then`. You may also want to review [How to avoid using select](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba) it will speed up your code a lot. Also just saying `Dim Partno` only declares it as a Variant you should turn on `Option Explicit` and declare your variables correctly. — BerticusMaximus, Oct 03 '17 at 15:33
I have tried to rewrite the code to avoid select and activate. I modified code I found to try to make it work. It attempts to fill in the fields but with #N/A for every field. Not sure what its doing. — guyjj, Oct 12 '17 at 14:31
Could you edit your post with your new code so were both looking at the same thing? — BerticusMaximus, Oct 12 '17 at 14:41
First VLookup is a `WorksheetFunction`. Try `WorksheetFunction.VLookup(.Cells(C, 2).Value, rngLookup, 2, False)`. — BerticusMaximus, Oct 12 '17 at 19:33
Tried changing application. to worksheetfunctioin. returns blanks instead of #N/A — guyjj, Oct 13 '17 at 15:06
That's a start but I think i'm just going to try and program this from scratch. Just to be clear you're looping through `Col B` and moving data to `Col G` and searching for your data in `Col B` on the other sheet? — BerticusMaximus, Oct 13 '17 at 17:28

score 0 · Answer 1 · answered Oct 13 '17 at 17:49

I'm not sure why your VLookup isn't working so i tried to replicate it with .Find. Give the below code a try and let me know if it works.

Sub MoveData()

    Dim wbk1 As Workbook, wbk2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lRow1 As Long, lRow2 As Long
    Dim Cell As Range, Found As Range

    Set wbk1 = Workbooks("cost_bom.txt")
    Set wbk2 = Workbooks("comp-price.xlsx")
    Set ws1 = wbk1.Worksheets("cost_bom")
    Set ws2 = wbk2.Worksheets("Sheet1")

    With ws2
        'Find last row in Col B
        lRow2 = .Range("B" & .Rows.Count).End(xlUp).Row
        'Loop through col B to find values
        For Each Cell In .Range("B4:B" & lRow2)
            'Search ws1 for Value
            Set Found = ws1.Columns(2).Find(What:=Cell.Value, _
                After:=ws1.Cells(1, 2), _
                LookIn:=xlFormulas, _
                LookAt:=xlWhole, _
                SearchOrder:=xlByRows, _
                SearchDirection:=xlPrevious, _
                MatchCase:=False)
            If Not Found Is Nothing Then
                Cell.Offset(0, 5).Value = ws1.Cells(Found.Row, Found.Column + 1).Value
            End If
        Next Cell
    End With

End Sub

Original should have worked. I had bad data on the comp-price sheet. Thanks for the suggestion to get rid of the .activates. Works faster now without hopping to private function for each part search. — guyjj, Oct 16 '17 at 19:15

Find a values in workbook2 and copy offset value to workbook1

1 Answers1