Matching Item numbers for multi level BOM

[cameron.houston]

Hi All,

I am creating a button that has a sub in it that goes through a drawing and finds all the parts lists, if any items in the parts list are shared between the BOM (1 part being used in 2 weldments for example) then it changes the item number of the second instance to be that of the first instance. It does this by comparing full file names between the two values. When they match change the number to that of the matcher. I have got this to work but it runs a little slow because for a 100 item BOM each item is compared to 100 and thus that takes a little longer then I would like (about 60seconds to run). After thinking about it I realized I did not need to compare each item to all the items, I just needed to compare until it found a duplicate and then exit the search loop and go to the next value. Example being Item 1 does not need to compare to the rest of the 99 values because even if it does have a match in position 100 I do not want to change item 1s number to that of item 100. I want to change item 100 to that of 1. For my code however I am having trouble exiting the comparison for loops which is causing me trouble. An example of the trouble is this:

I have 3 BOMs, each one shares Part X, and is numbered 1 in BOM 1, 4 in BOM 2, and 7 in BOM 3. when I run my button because I cannot get it to leave the comparison loop once it finds it first match all the Part X's ended up getting item number 7 from BOM 3 because it is the last instance. (I can get this to do what I want by stepping through my for loops backwards and thus everything ends up as the top most occurrence, but I would like to get my exit fors working because it saves me on unnecessary comparisons)


Here is my code below.

Public Sub MatchingNumber()

Debug.Print ThisApplication.Caption

'define active document as drawing doc. Will produce an error if its not a drawing doc
Dim oDrawDoc As DrawingDocument
Set oDrawDoc = ThisApplication.ActiveDocument

'Store all the sheets of drawing
Dim oSheets As Sheets
Set oSheets = oDrawDoc.Sheets

Dim oSheet As Sheet

'Loop through all the sheets
For Each oSheet In oSheets

Dim oPartsLists As PartsLists
Set oPartsLists = oSheet.PartsLists

'Loop through all the part lists on that sheet
Dim oPartList As PartsList

'For every parts list on the sheet
For Each oPartList In oPartsLists

For i3 = 1 To oPartList.PartsListRows.Count

'Store the Item number and file referenced in that row to compare
oItem = FindItem(oPartList)
oDescription = FindDescription(oPartList)
oDescripCheck = oPartList.PartsListRows.Item(i3).Item(oDescription).Value
oNumCheck = oPartList.PartsListRows.Item(i3).Item(oItem).Value


'Check to see if the BOM item is a virtual component if it is do not try and get the reference part
If oPartList.PartsListRows.Item(i3).ReferencedFiles.Count = 0 Then
oRefPart = " "
End If

'Check to see if the BOM item is a virtual component if it is try and get the reference part
If oPartList.PartsListRows.Item(i3).ReferencedFiles.Count > 0 Then
oRefPart = oPartList.PartsListRows.Item(i3).ReferencedFiles.Item(1).FullFileName
End If

MsgBox (" We are comparing " & oRefPart)

'''''Create a comparison loop to go through the drawing that checks the oRefPart against other BOM items and see if there is a match.'''''



'Store all the sheets of drawing

Dim oSheets2 As Sheets
Set oSheets2 = oDrawDoc.Sheets
Dim oSheet2 As Sheet


'For every sheet in the drawing
For Each oSheet2 In oSheets2

'Get all the parts list on a single sheet
Dim oPartsLists2 As PartsLists
Set oPartsLists2 = oSheet2.PartsLists
Dim oPartList2 As PartsList


'For every parts list on the sheet
For Each oPartList2 In oPartsLists2

oItem2 = FindItem(oPartList2)
oDescription2 = FindDescription(oPartList2)


'Go through all the rows of the part list
For i6 = 1 To oPartList2.PartsListRows.Count

'Check to see if the part is a not a virtual component, if not, get the relevent comparison values
If oPartList2.PartsListRows.Item(i6).ReferencedFiles.Count > 0 Then

oNumCheck2 = oPartList2.PartsListRows.Item(i6).Item(oItem2).Value
oRefPart2 = oPartList2.PartsListRows.Item(i6).ReferencedFiles.Item(1).FullFileName

'Compare the file names, if they match change the part list item number for the original to that of the match
If oRefPart = oRefPart2 Then
oPartList.PartsListRows.Item(i3).Item(1).Value = oNumCheck2


''''''''This is where I want it to exit the loop and grab the next original value'''''''
EndLoop
EndLoop
EndLoop

End If


'For virtual components get the following comparison values
ElseIf oPartList2.PartsListRows.Item(i6).ReferencedFiles.Count = 0 Then


oNumCheck2 = oPartList2.PartsListRows.Item(i6).Item(oItem2).Value
oDescripCheck2 = oPartList2.PartsListRows.Item(i6).Item(oDescription2).Value
'Compare the descriptions and if they match change the part list item number for the original to that of the match
If oDescripCheck = oDescripCheck2 Then
oPartList.PartsListRows.Item(i3).Item(1).Value = oNumCheck2


''''''''This is where I want it to exit the loop and grab the next original value'''''''

EndLoop
EndLoop
EndLoop

End If



Else

''''''''This is where if no matches were found I want it to continue going through the comparison loop'''''''
End If


Next
Next
Next

Next
Next
Next

'MsgBox ("Matching Numbers has been finished")
End Sub