VBA - Counting quantity of parts in assemblies

[pball]

I'm trying to make a list of part numbers, descriptions, and quantities so I can import it into an erp program. The issue I'm running into is getting the total quantity of a part in an assembly and all of it's sub-assemblies. I've modified some example code that created a bom list from the help. However going through the bom will not give a total number for the quantity of parts. Going through the bom list will only give the quantity of parts in a single assembly and not multiply the quantities if that assembly is used multiple times. I figure it would be possible if an assembly was used twice to remember that and then multiple all subcomponet quantities by two, but a simplier way would be nice.

Example:

Main assembly

    Sub-A

        Part1

    Sub-A

        Part1

The bom code would list one Main assembly, two Sub-A, and one Part1.

Is there an easy way to count the total number of occurances of a part in an assembly and all sub-assemblies? I don't need any type of structured list as I will be sorting everything by part number afterwards. Thanks

Original BOM code example (sorry it wasn't indented where I got it)

Public Sub BOMQuery()
' Set a reference to the assembly document.
' This assumes an assembly document is active.
Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument

Dim FirstLevelOnly As Boolean
If MsgBox("First level only?", vbYesNo) = vbYes Then
FirstLevelOnly = True
Else
FirstLevelOnly = False
End If

' Set a reference to the BOM
Dim oBOM As BOM
Set oBOM = oDoc.ComponentDefinition.BOM

' Set whether first level only or all levels.
If FirstLevelOnly Then
oBOM.StructuredViewFirstLevelOnly = True
Else
oBOM.StructuredViewFirstLevelOnly = False
End If

' Make sure that the structured view is enabled.
oBOM.StructuredViewEnabled = True

'Set a reference to the "Structured" BOMView
Dim oBOMView As BOMView
Set oBOMView = oBOM.BOMViews.Item("Structured")

Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description"
Debug.Print "----------------------------------------------------------------------------------"

'Initialize the tab for ItemNumber
Dim ItemTab As Long
ItemTab = -3
Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab)
End Sub

Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long)
ItemTab = ItemTab + 3
' Iterate through the contents of the BOM Rows.
Dim i As Long
For i = 1 To oBOMRows.Count
' Get the current row.
Dim oRow As BOMRow
Set oRow = oBOMRows.Item(i)

'Set a reference to the primary ComponentDefinition of the row
Dim oCompDef As ComponentDefinition
Set oCompDef = oRow.ComponentDefinitions.Item(1)

Dim oPartNumProperty As Property
Dim oDescripProperty As Property

If Typeof oCompDef Is VirtualComponentDefinition Then

'Get the file property that contains the "Part Number"
'The file property is obtained from the virtual component definition
Set oPartNumProperty = oCompDef.PropertySets _
.Item("Design Tracking Properties").Item("Part Number")

'Get the file property that contains the "Description"
Set oDescripProperty = oCompDef.PropertySets _
.Item("Design Tracking Properties").Item("Description")

Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity; Tab(30); _
oPartNumProperty.Value; Tab(70); oDescripProperty.Value
Else

'Get the file property that contains the "Part Number"
'The file property is obtained from the parent
'document of the associated ComponentDefinition.
Set oPartNumProperty = oCompDef.Document.PropertySets _
.Item("Design Tracking Properties").Item("Part Number")

'Get the file property that contains the "Description"
Set oDescripProperty = oCompDef.Document.PropertySets _
.Item("Design Tracking Properties").Item("Description")

Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity; Tab(30); _
oPartNumProperty.Value; Tab(70); oDescripProperty.Value

'Recursively iterate child rows if present.
If Not oRow.ChildRows Is Nothing Then
Call QueryBOMRowProperties(oRow.ChildRows, ItemTab)
End If
End If
Next
ItemTab = ItemTab - 3
End Sub

[pball]

Well adding a counter in the recursive part of that code wasn't actually that hard. So here is the code I have now.

The first number in the quantity column is the total quantity over all and the second number is the quantity in one instance of the assembly.

Item          Quantity       Part Number          Description
---------------------------------------------------------------
0                1   1       main-assembly            main assembly 
1                1   1       456                      some part
2                2   2       sub-assembly 1           sub-assy
  2.1            2   1       789                      guess what a part
  2.2            4   2       092                      not a part

This solves my issue for getting the total quantity over all, but if anyone has another method or input I'd love to hear it.

Public Sub BOMQuery()
    ' Set a reference to the assembly document.
    ' This assumes an assembly document is active.
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument

    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM

    oBOM.StructuredViewFirstLevelOnly = False

    ' Make sure that the structured view is enabled.
    oBOM.StructuredViewEnabled = True

    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item("Structured")

    Debug.Print "Item"; Tab(15); "Quantity"; Tab(30); "Part Number"; Tab(70); "Description"
    Debug.Print "----------------------------------------------------------------------------------"
    Debug.Print "0"; Tab(18); "1   1"; Tab(30); oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value; Tab(70); oDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value

    'Initialize the tab for ItemNumber
    Dim ItemTab As Long
    ItemTab = -3
    Call QueryBOMRowProperties(oBOMView.BOMRows, ItemTab)
End Sub

Private Sub QueryBOMRowProperties(oBOMRows As BOMRowsEnumerator, ItemTab As Long, Optional SubQty As Integer = 1)
    ItemTab = ItemTab + 3
    Dim QtyMp As Integer
    QtyMp = SubQty
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
        For i = 1 To oBOMRows.Count
            ' Get the current row.
            Dim oRow As BOMRow
            Set oRow = oBOMRows.Item(i)

            'Set a reference to the primary ComponentDefinition of the row
            Dim oCompDef As ComponentDefinition
            Set oCompDef = oRow.ComponentDefinitions.Item(1)

            Dim oPartNumProperty As Property
            Dim oDescripProperty As Property

            If TypeOf oCompDef Is VirtualComponentDefinition Then

                'Get the file property that contains the "Part Number"
                'The file property is obtained from the virtual component definition
                Set oPartNumProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Part Number")

                'Get the file property that contains the "Description"
                Set oDescripProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Description")

                Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity * QtyMp; " "; oRow.ItemQuantity; Tab(30); oPartNumProperty.Value; Tab(70); oDescripProperty.Value
            Else

                'Get the file property that contains the "Part Number"
                'The file property is obtained from the parent
                'document of the associated ComponentDefinition.
                Set oPartNumProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number")

                'Get the file property that contains the "Description"
                Set oDescripProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Description")

                Debug.Print Tab(ItemTab); oRow.ItemNumber; Tab(17); oRow.ItemQuantity * QtyMp; " "; oRow.ItemQuantity; Tab(30); oPartNumProperty.Value; Tab(70); oDescripProperty.Value

                'Recursively iterate child rows if present.
                If Not oRow.ChildRows Is Nothing Then
                    Call QueryBOMRowProperties(oRow.ChildRows, ItemTab, oRow.ItemQuantity)
                End If
            End If
        Next
    ItemTab = ItemTab - 3
End Sub

[Anonymous]

@pball Are you still working with the last code you posted? I need to achieve the exact same thing and export to excel.

Searching through forums it seems that its been a long standing issue. Surely Autodesk can add an option to include assemblies in the 'Parts Only' BOM?

[pball]

I have a VBA script and vb.net addon created with the code above as a base. I don't want to post all the code as it's custom to suit my needs but I'll be happy to help you get something put together.

In my VBA script I stored the part numbers and quantities inside of an array while recursing through the BOM to get all the info. Then I sorted the array and wrote it to an excel file. In the VB.net addon I did much the same but used a class to store the info.

Let me know a bit more of what you're looking to do and I can try to strip some code I have down to something more generic.

[Anonymous]

My end goal is to have an iLogic rule (possibly a vba macro) that runs from an .iam and exports a list of all parts and sub-assemblies and their respective total quantities to a pre-existing excel template, which will have pricing columns on it.

[frederic.vandenplas]

Hi,

The code you are using is useless, you should read this post and bookmark it! I also did it your way earlier. But The result are ... Well...

Read The part off leafoccurences and use oOcc.count

http://modthemachine.typepad.com/my_weblog/2009/03/accessing-assembly-components.html

[pball]

Here is a stripped down version of my excel BOM export script. I hard coded it to use an existing excel file at "C:\Misc\testbom.xlsx". This code is formatted as a VBA macro currently.

This requires an excel reference to be added in the VBA editor. Under Tools - References there is a list of references, check the "Microsoft Excel 16.0 Object Library".

After that it should work when you run bomexport. It will add the part number, description, and quantity to the test.xlsx file and if there are existing rows in that file it will start at the first empty row.

Give my useless code a shot and let me know how it works. I did a test and everything seemed good part and quantity wise but double check your results.

I might have a way to replace the array which would greatly reduce the extra functions needed, not certain if it'll work or what trade offs there might be.

Public Sub bomexport()
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveEditDocument
    
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True

    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item("Structured")
    
    Dim bomlist() As String
    ReDim bomlist(0 To 0, 0 To 2) As String
    
    bomexportarray darray:=bomlist, PN:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value, Desc:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value, QTY:="1"

    Call BomRecurse(oBOMView.BOMRows, bomlist)
    
    If (bomlist(0, 0) <> "") Then
        Dim myFile As String
        myFile = "C:\Misc\testbom.xlsx"
        
        QuickSort2D SortArray:=bomlist, col:=0, L:=LBound(bomlist, 1), R:=UBound(bomlist, 1), bAscending:=True
                
        Dim objWorkbook As Workbook
        Set objWorkbook = Workbooks.Open(myFile)
        Dim objworksheet As WorkSheet
        Set objworksheet = objWorkbook.Worksheets("Sheet1")
        
        'Find first empty row for adding to existing spreadsheet
        num = 1
        While (objworksheet.Cells(num, 1) <> "")
            num = num + 1
        Wend
                        
        For L = LBound(bomlist, 1) To UBound(bomlist, 1)
            objworksheet.Cells(num, 1).Value = bomlist(L, 0)
            objworksheet.Cells(num, 2).Value = bomlist(L, 1)
            objworksheet.Cells(num, 3).Value = bomlist(L, 2)
            num = num + 1
        Next L

        objWorkbook.Close True

        MsgBox ("Export complete")
    Else
        MsgBox ("Zero Items Exported")
    End If
 
End Sub

Function bomexportarray(darray() As String, PN As String, Desc As String, QTY As String)
    num = IsInArray(darray, PN, 0)
    If (num = False) Then
        Dim temp() As String
        temp = TransposeDim(darray)
        num = UBound(temp, 2) + IIf(temp(0, 0) <> "", 1, 0)
        ReDim Preserve temp(0 To 2, 0 To num) As String
        darray = TransposeDim(temp)
        darray(UBound(darray, 1), 0) = PN
        darray(UBound(darray, 1), 1) = Desc
        darray(UBound(darray, 1), 2) = QTY

    Else:
        darray(num, 2) = CInt(darray(num, 2)) + CInt(QTY)
    End If
End Function

Private Sub BomRecurse(oBOMRows As BOMRowsEnumerator, bomlist() As String, Optional SubQty As Integer = 1)
    On Error Resume Next
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
    For i = 1 To oBOMRows.Count
        ' Get the current row.
        Dim oRow As BOMRow
        Set oRow = oBOMRows.Item(i)

        'Set a reference to the primary ComponentDefinition of the row
        Dim oCompDef As ComponentDefinition
        Set oCompDef = oRow.ComponentDefinitions.Item(1)
            
        Dim oPartNumProperty As String
        Dim oDescripProperty As String
        Dim oVendorProperty As String
            
        If (TypeOf oCompDef Is VirtualComponentDefinition) Then
        
            oPartNumProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            oDescripProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Description").Value
        
            bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, QTY:=oRow.ItemQuantity * SubQty
        Else
                    
            oPartNumProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            oDescripProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Description").Value
        
            bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, QTY:=oRow.ItemQuantity * SubQty
                
            'Recursively iterate child rows if present.
            If Not oRow.ChildRows Is Nothing Then Call BomRecurse(oRow.ChildRows, bomlist, oRow.ItemQuantity * SubQty)
        End If
    Next
End Sub

Function IsInArray(sarray() As String, stext As String, Optional column As Integer = -1)
'Assumes array is arr(rows,columns) and column is zero if array is zero based
'Returns false if nothing found, returns row number if found
    If (column = -1) Then
        For i = LBound(sarray) To UBound(sarray)
            If (stext = sarray(i)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    ElseIf (column <> -1) Then
        For i = LBound(sarray, 1) To UBound(sarray, 1)
            If (stext = sarray(i, column)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    Else:
    IsInArray = False
    End If
End Function

Sub QuickSort2D(SortArray, col, L, R, bAscending)
    'Originally Posted by Jim Rech 10/20/98 Excel.Programming
    'Modified to sort on first column of a two dimensional array
    'Modified to handle a second dimension greater than 1 (or zero)
    'Modified to do Ascending or Descending
    Dim i, j, X, Y, mm

    i = L
    j = R
    X = SortArray((L + R) / 2, col)
    If bAscending Then
        While (i <= j)
            While (SortArray(i, col) < X And i < R)
                i = i + 1
            Wend
            While (X < SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    Else
        While (i <= j)
            While (SortArray(i, col) > X And i < R)
                i = i + 1
            Wend
            While (X > SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    End If
    If (L < j) Then Call QuickSort2D(SortArray, col, L, j, bAscending)
    If (i < R) Then Call QuickSort2D(SortArray, col, i, R, bAscending)
End Sub

[Anonymous]

When stepping through the code I got this error on the Function bomexportarray

Compile error:

Sub or Function not defined

[Anonymous]

I think its this line

temp = TransposeDim(darray)

[pball]

Whoops missed this function. If you like what this code does I found a method to replace all this array stuff with something more simple.

Function TransposeDim(v() As String)
' Custom Function to Transpose a 0-based array (v)

    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim TempArray() As String

    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

    ReDim TempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            TempArray(X, Y) = v(Y, X)
        Next Y
    Next X

    TransposeDim = TempArray
End Function

[frederic.vandenplas]

Hi @pball ,

I did not want to offend you with my useless remark, What i actually meant tot say is the way to traverse The assembly gives better results with the leafoccurences function. I've cretaed a lot of addins with traversing assy's and my outcome was that traversing The assembly you do is more complex to handle, and more complex to read as programmer.

Sorry if you felt offended!

[Anonymous]

@pball yeah would love to see the simplified version.

The code was working for me last time I was here, although now I am getting an error on this line:

Dim objWorkbook As Workbook

The error is:

Compile error:

User-defined type not defined

What could be causing this? We have since upgraded from 2015 to 2017, but I doubt this would be the cause.

[Anonymous]

Doh!!!! forgot to add the reference to Microsoft excel library! that's taken care of the error.

Still interested in the simplified version when you have the time to share.

[pball]

Glad you got that figured out. I've been swamped at work lately so I forgot about this. I believe it will be possible to simplify this some but it will be a while before I can play around with this.

[Anonymous]

No problem, I know the feeling  What method was it out of interest & I could do some digging myself in the mean time? 

[Anonymous]

Hi @frederic.vandenplas

Am I correct in saying that your suggestion of using leaf occurrences for what we are trying to achieve here, is not appropriate as that will only return parts?  

[gerarda]

Hi,

I've been using this with good results, but wanted to get the Material property from the BOM into the spreadsheet as well.

I've been unable to do this due to my lack of vba coding skills, I've added all the required items as far as I know, but there must be something in one of the sub-routines, as I only get an empty column where I was expecting the material to show.

Can anyone help?

[pball]

Inside the BomRecurse function you can use the following line to get the current part material. You'll have to add a spot in the bomarray function for material along with adding to the excel area.

oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Material").Value

If you need more help let me know, busy now so hope this much helps.

[gerarda]

Thanks for your answer, however I've got that part all ok. It's getting the material property in the 3rd column of the excel file that's going wrong. Trying along I could even get column 2 and 3 to show the Description, or column 2 showing the Material, but failing to get both the Mat and Descr. out.

I'm sure it's something small, but I can't find it.

Here's my adapted version of the code:

[code]

Public Sub bomexportGvA()
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveEditDocument
    
    ' Set a reference to the BOM
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM
    
    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True

    'Set a reference to the "Structured" BOMView
    Dim oBOMView As BOMView
    Set oBOMView = oBOM.BOMViews.Item("Structured")
    
    Dim bomlist() As String
    ReDim bomlist(0 To 0, 0 To 3) As String
    
    bomexportarray darray:=bomlist, PN:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value, Desc:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Description").Value, Mat:=oDoc.PropertySets.Item("Design Tracking Properties").Item("Material").Value, QTY:="1"

    Call BomRecurse(oBOMView.BOMRows, bomlist)
    
    If (bomlist(0, 0) <> "") Then
        Dim myFile As String
        myFile = "C:\testbom.xlsx"
        
        QuickSort2D SortArray:=bomlist, col:=0, L:=LBound(bomlist, 1), R:=UBound(bomlist, 1), bAscending:=True
                
        Dim objWorkbook As Workbook
        Set objWorkbook = Workbooks.Open(myFile)
        Dim objworksheet As WorkSheet
        Set objworksheet = objWorkbook.Worksheets("Sheet1")
        
        'Find first empty row for adding to existing spreadsheet
        num = 1
        While (objworksheet.Cells(num, 1) <> "")
            num = num + 1
        Wend
                        
        For L = LBound(bomlist, 1) To UBound(bomlist, 1)
            objworksheet.Cells(num, 1).Value = bomlist(L, 0)
            objworksheet.Cells(num, 2).Value = bomlist(L, 1)
            objworksheet.Cells(num, 3).Value = bomlist(L, 2)
            objworksheet.Cells(num, 4).Value = bomlist(L, 3)
            num = num + 1
        Next L

        objWorkbook.Close True

        MsgBox ("Export complete")
    Else
        MsgBox ("Zero Items Exported")
    End If
 
End Sub

Function bomexportarray(darray() As String, PN As String, Desc As String, Mat As String, QTY As String)
    num = IsInArray(darray, PN, 0)
    If (num = False) Then
        Dim temp() As String
        temp = TransposeDim(darray)
        num = UBound(temp, 2) + IIf(temp(0, 0) <> "", 1, 0)
        ReDim Preserve temp(0 To 3, 0 To num) As String
        darray = TransposeDim(temp)
        darray(UBound(darray, 1), 0) = PN
        darray(UBound(darray, 1), 1) = Desc
        darray(UBound(darray, 1), 2) = Mat
        darray(UBound(darray, 1), 3) = QTY

    Else:
        darray(num, 3) = CInt(darray(num, 3)) + CInt(QTY)
    End If
End Function

Private Sub BomRecurse(oBOMRows As BOMRowsEnumerator, bomlist() As String, Optional SubQty As Integer = 1)
    On Error Resume Next
    ' Iterate through the contents of the BOM Rows.
    Dim i As Long
    For i = 1 To oBOMRows.Count
        ' Get the current row.
        Dim oRow As BOMRow
        Set oRow = oBOMRows.Item(i)

        'Set a reference to the primary ComponentDefinition of the row
        Dim oCompDef As ComponentDefinition
        Set oCompDef = oRow.ComponentDefinitions.Item(1)
            
        Dim oPartNumProperty As String
        Dim oDescripProperty As String
        Dim oMatProperty As String
        Dim oVendorProperty As String
            
        If (TypeOf oCompDef Is VirtualComponentDefinition) Then
        
            oPartNumProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            oDescripProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Description").Value
            oMatProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Material").Value
        
            bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, Mat:=oMatProperty, QTY:=oRow.ItemQuantity * SubQty
        Else
                    
            oPartNumProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Part Number").Value
            oDescripProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Description").Value
            oMatProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Material").Value
        
            bomexportarray darray:=bomlist, PN:=oPartNumProperty, Desc:=oDescripProperty, Mat:=oMatProperty, QTY:=oRow.ItemQuantity * SubQty
                
            'Recursively iterate child rows if present.
            If Not oRow.ChildRows Is Nothing Then Call BomRecurse(oRow.ChildRows, bomlist, oRow.ItemQuantity * SubQty)
        End If
    Next
End Sub

Function IsInArray(sarray() As String, stext As String, Optional column As Integer = -1)
'Assumes array is arr(rows,columns) and column is zero if array is zero based
'Returns false if nothing found, returns row number if found
    If (column = -1) Then
        For i = LBound(sarray) To UBound(sarray)
            If (stext = sarray(i)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    ElseIf (column <> -1) Then
        For i = LBound(sarray, 1) To UBound(sarray, 1)
            If (stext = sarray(i, column)) Then
                IsInArray = i
                Exit For
            End If
        Next i
    Else:
    IsInArray = False
    End If
End Function
Function TransposeDim(v() As String)
' Custom Function to Transpose a 0-based array (v)

    Dim X As Long, Y As Long, Xupper As Long, Yupper As Long
    Dim TempArray() As String

    Xupper = UBound(v, 2)
    Yupper = UBound(v, 1)

    ReDim TempArray(Xupper, Yupper)
    For X = 0 To Xupper
        For Y = 0 To Yupper
            TempArray(X, Y) = v(Y, X)
        Next Y
    Next X

    TransposeDim = TempArray
End Function
Sub QuickSort2D(SortArray, col, L, R, bAscending)
    'Originally Posted by Jim Rech 10/20/98 Excel.Programming
    'Modified to sort on first column of a two dimensional array
    'Modified to handle a second dimension greater than 1 (or zero)
    'Modified to do Ascending or Descending
    Dim i, j, X, Y, mm

    i = L
    j = R
    X = SortArray((L + R) / 2, col)
    If bAscending Then
        While (i <= j)
            While (SortArray(i, col) < X And i < R)
                i = i + 1
            Wend
            While (X < SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    Else
        While (i <= j)
            While (SortArray(i, col) > X And i < R)
                i = i + 1
            Wend
            While (X > SortArray(j, col) And j > L)
                j = j - 1
            Wend
            If (i <= j) Then
                For mm = LBound(SortArray, 2) To UBound(SortArray, 2)
                    Y = SortArray(i, mm)
                    SortArray(i, mm) = SortArray(j, mm)
                    SortArray(j, mm) = Y
                Next mm
                i = i + 1
                j = j - 1
            End If
        Wend
    End If
    If (L < j) Then Call QuickSort2D(SortArray, col, L, j, bAscending)
    If (i < R) Then Call QuickSort2D(SortArray, col, i, R, bAscending)
End Sub

[/code]

[pball]

Finally had time to look at this and I found a simple issue. You need to add ".Document" after oCompDef in the line getting the material iProperty. You'll notice that in my code. I want to say that is required because the parts are being accessed through the BOM and not normally.

Before
oMatProperty = oCompDef.PropertySets.Item("Design Tracking Properties").Item("Material").Value

Fixed

oMatProperty = oCompDef.Document.PropertySets.Item("Design Tracking Properties").Item("Material").Value