Extracting data from different workbooks based on a product code

Question

I have 18000 items with a CPV product code in one workbook, and each of these CPV codes correspond to a UNSPC code which can be found in one of 45 workbooks in a particular folder. For each CPV code I want to search through each of these other workbooks until it is found, and then copy the corresponding UNSPC code to the cell in the column directly next to the CPV code in the original workbook.

Currently, my code is:

Sub findUNSPC()
Dim file As String
Dim app As New Excel.Application
Dim book As Excel.Workbook
Dim StartNumber As Integer, EndNumber As Integer, check As Integer, cpv As Long, unspc As Long
EndNumber = Sheet2.Range("D" & Rows.Count).End(xlUp).Row

For StartNumber = 2 To EndNumber
Sheet2.Cells(StartNumber, 4).Activate
    cpv = ActiveCell.Value
file = Dir("C:\Users\Gylfi.heimisson\Documents\Enzen\CPV to UNSPSC\" & "*.xlsx")
    Do While Len(file) > 0
    Debug.Print file
        file = Dir
        Set book = app.Workbooks.Add("Source Directory" & file) 'Source Directory is just where the files are located on my computer
        book.Worksheets("Mappings").Activate
        check = book.Application.WorksheetFunction.Match(cpv, "B:B", 0)
            If check <> "#N/A" Then
            unspc = book.Application.WorksheetFunction.Index("S:S", check)
            End If
    Loop
book.Close SaveChanges:=False
app.Quit
Set app = Nothing
ActiveCell.Offset(0, 1).Value = usnpc
Next StartNumber
End Sub

I am getting a Runtime Error '1004': Application-defined or object-defined error" at line 17. I am also unsure about the rest of the code.

I realise that I have probably written this in an inefficient way as well, so any suggestions on what I've done wrong, and how to make it work, will be greatly appreciated!

`...error" at line 17`: You mean here: `check = book.Application.WorksheetFunction.Match(cpv, "B:B", 0)`? Of course it will. `.Application` is not a valid property of `book`. Change it to `check Application.Match(cpv, book.Sheets("Mappings").Range("B:B"), 0)`. — WGS, Feb 11 '14 at 17:14
...and then check using `IsError(check)` to see if the match failed (it will not be "#N/A" if there's no match) — Tim Williams, Feb 11 '14 at 17:22
I have just tried with both `check Application.Match(cpv, book.Sheets("Mappings").Range("B:B"), 0)` and `check = Application.Match(cpv, book.Sheets("Mappings").Range("B:B"), 0)` and both still return an Error 1004. — Gylgamesh, Feb 11 '14 at 17:23
Personally, this code has many pitfalls. I'm rewriting much of it right now because I believe that simply qualifying properly will make this work. Wait a few. — WGS, Feb 11 '14 at 17:30

score 1 · Answer 1 · edited May 23 '17 at 12:05

Try this:

Sub FindUNSPC()

    Dim FileName As String
    Dim TargetBk As Workbook, TargetSht As Worksheet
    Dim StartNumber As Long, EndNumber As Long
    Dim CurrCell As Range, FoundCell As Range
    Dim CPV As Variant, UNSPC As Variant

    EndNumber = ThisWorkbook.Sheet2.Range("D" & Rows.Count).End(xlUp).Row

    For StartNumber = 2 to EndNumber

        Set CurrCell = Sheet2.Range("D" & StartNumber)
        CPV = CurrCell.Value
        FileName = Dir("C:\Users\Gylfi.heimisson\Documents\Enzen\CPV to UNSPSC\" & "*.xlsx")

        Do While Len(FileName) > 0

            Debug.Print FileName
            Set TargetBk = Workbooks.Add("SrcDir" & FileName) 'Modify as necessary.
            Set TargetSht = TargetBk.Sheets("Mappings")

            With TargetSht.Range("B:B")
                On Error Resume Next
                Set FoundCell = .Find What:=CPV
                If Not FoundCell Is Nothing Then
                    USNPC = FoundCell.Offset(0,17).Value
                End If
                On Error GoTo 0
            End With

            TargetBk.Close

        Loop

        CurrCell.Offset(0, 1).Value = USNPC

    Next StartNumber

End Sub

First off, stop using .Activate. It's not good code. See here for some reasons why as well as some things that can be used as alternatives.

Second, using .Find in VBA is much superior than using Match-Index to return a value as the latter can cause all sorts of trouble. If I understood your intentions correctly, you just want to check in the B column if CPV exists and return the value from the respective S column.

.Find in the code above looks for CPV in column B as well, returning the value from the offset 17 columns away in S if .Find returns a valid range (.FoundCell). We assign the found value to USNPC and close the book inside the inner loop where we opened it. Outside the loop, we input USNPC to the the right cell of CPV. Then we loop again for next CPV.

The above is hacked together pretty much from what you have, so there might be a part that throws an error. Let us know if this works (or not).

Thanks for this, and for the advice. This is working much better than mine - I had to add in `FileName = Dir` after `Debug.Print FileName`and an `If` statement between the `Loop` and `Next` that is essentially a copy of the earlier `If` statement. It's now running well until it's gone through all the files in the folder for the first CPV code, but then it attempts to loop again and comes up with Runtime Error 1004 again. — Gylgamesh, Feb 12 '14 at 09:04
An idea I had to stop this is to add an `If` statement to check if TargetBk is the final one in the folder ("Mapping 98_Other Community Social Personal Services") then it exits the loop, i.e.: `If TargetBk = Workbooks.Add("C:\Users\Gylfi.heimisson\Documents\Enzen\CPV to UNSPC\Mapping 98_Other Community Social Personal Services") Then TargetBk.Close SaveChanges:=False GoTo Here End If` where here is the `CurrCell` line at the end. I know I don't have the right syntax though, any way to make that work? — Gylgamesh, Feb 12 '14 at 09:28

score 0 · Answer 2 · answered Feb 12 '14 at 12:01

Based on BK201's code, I've written a version that seems to work.

Sub FindUNSPC()

Dim FileName As String
Dim TargetBk As Excel.Workbook, TargetSht As Excel.Worksheet
Dim StartNumber As Long, EndNumber As Long
Dim CurrCell As Range, FoundCell As Range
Dim CPV As Variant, UNSPC As Variant

EndNumber = Sheet2.Range("D" & Rows.Count).End(xlUp).Row


FileName = Dir("C:\Users\Gylfi.heimisson\Documents\Enzen\CPV to UNSPSC\" & "*.xlsx")

    Do While Len(FileName) > 0

     Debug.Print FileName
        FileName = Dir
        Set TargetBk = Workbooks.Add("C:\Users\Gylfi.heimisson\Documents\Enzen\CPV to UNSPSC\" & FileName)
        Set TargetSht = TargetBk.Sheets("Mappings")

        For StartNumber = 2 To EndNumber
            Set CurrCell = Sheet2.Range("D" & StartNumber)
            If CurrCell.Offset(0, 1).Value <> "" Then
            GoTo Here
            End If
            CPV = CurrCell.Value

        With TargetSht.Range("B:B")
            On Error Resume Next
            Set FoundCell = .Find(What:=CPV)
            If Not FoundCell Is Nothing Then
                UNSPC = FoundCell.Offset(0, 17).Value
                CurrCell.Offset(0, 1).Value = UNSPC
            End If
            On Error GoTo 0
        End With

Here:       Next StartNumber

        If FileName = "C:\Users\Gylfi.heimisson\Documents\Enzen\CPV to UNSPC\Mapping 98_Other_Community_Social_Personal_Services.xlsx" Then
        TargetBk.Close SaveChanges:=False
        Exit Do
        Else
        TargetBk.Close SaveChanges:=False
        End If


    Loop


End Sub

Extracting data from different workbooks based on a product code

2 Answers2