Parsing a Bill of Materials

[Pat]

Hi,



I am trying to manipulate a Bill of Material (BOM) and hoping someone can help me accomplish this task. I import an Excel BOM into a new table. The BOM has 8 fields one of which is call “designator”. In a BOM the designator identifies an electronic component on a printed circuit board. You can think of it as the name for each component. The syntax is a letter followed by a number such as C1 or R12. For each record their can be one or more designators in the designator field. There is also a quantity field that equals the number of designators. The method for listing more than one designator has more than one option. It’s best to give examples:

Example of one designator in the field:

C1

Example of three designators in the field:

C1, C3, C17

Example of four designators in the field:

C2-C4, C9

What I need to do is:

1) add a new field called “reference”

2) using the quantity field for each record make one less copy of the record than the number in the quantity field.

3) parse out each designator into the newly created reference field.

4) Do this for all records.

As I read this I’m struggling with articulating what I need done so I’ll give an example.

BEFORE:

Designator PN Description Quantity

C1 123 capacitor 1

R1, R4 ABC resistor 2

D4-D6, D12 aaa diode 4

AFTER:

Designator PN Description Quantity REFERENCE

C1 123 capacitor 1 C1

R1, R4 ABC resistor 2 R1

R1, R4 ABC resistor 2 R4

D4-D6, D12 aaa diode 4 D4

D4-D6, D12 aaa diode 4 D5

D4-D6, D12 aaa diode 4 D6

D4-D6, D12 aaa diode 4 D12

I was able to get some help on how to do this in Excel and I’ve listed the code below. This works but it’s an extra step. My goal is to automate it using visual basic in Access. Thanks in advance for your help.

Sub NormalizeBOM()
'
'
Application.ScreenUpdating = False
Dim designators() As String
lrow = Range("A" & Rows.Count).End(xlUp).Row
For i = lrow To 2 Step -1
  designator = Cells(i, 1).Value
  designators = Split(designator, ",")
  'count commas
  commacount = Len(designator) - Len(Replace(designator, ",", ""))
  For r = 1 To commacount + 1
     'check for dash
     If InStr(designators(r - 1), "-") Then
        num1 = Mid(designators(r - 1), 2, 1)
        num2 = Right(designators(r - 1), 1)
        letter = Left(designators(r - 1), 1)
        For n = num1 To num2
           If CInt(n) = CInt(num1) Then
              designators(r - 1) = letter & n
           Else
              ReDim Preserve designators(0 To UBound(designators) + 1) As String
              designators(UBound(designators)) = letter & n
           End If
        Next n
     End If
  Next r
  For s = LBound(designators) To UBound(designators)
     Cells(i, 1).Offset(1).EntireRow.Insert
     Cells(i, 1).EntireRow.Copy
     Cells(i, 1).Offset(1).PasteSpecial
     Cells(i, 1).Offset(1).Value = Trim(designators(s))
Next s
  Cells(i, 1).EntireRow.Delete
Next i
Application.ScreenUpdating = True

End Sub

[June7]

Set a VBA reference to Microsoft ActiveX Data Objects 2.8 Library.

Create a table to save the new records into. Replace the names Table1 and Table2 in the code with your table names. I did not have to change anything in the nested loops that parsed the designators and built the array.

Sub NormalizeBOM()
Dim rsSource As ADODB.Recordset
Dim rsDest As ADODB.Recordset
Dim designators() As String
Set rsSource = New ADODB.Recordset
Set rsDest = New ADODB.Recordset
CurrentDb.Execute "DELETE FROM Table2" 'can remove this line, I include it when testing code
rsSource.Open "SELECT * FROM Table1;", CurrentProject.Connection, adOpenForwardOnly, adLockPessimistic
rsDest.Open "SELECT * FROM Table2;", CurrentProject.Connection, adOpenDynamic, adLockPessimistic
While Not rsSource.EOF
   Designator = rsSource!Designator
   designators = Split(Designator, ",")
   'count commas
   commacount = Len(Designator) - Len(Replace(Designator, ",", ""))
   For r = 1 To commacount + 1
      'check for dash
      If InStr(designators(r - 1), "-") Then
         num1 = Mid(designators(r - 1), 2, 1)
         num2 = Right(designators(r - 1), 1)
         letter = Left(designators(r - 1), 1)
         For n = num1 To num2
            If CInt(n) = CInt(num1) Then
               designators(r - 1) = letter & n
            Else
               ReDim Preserve designators(0 To UBound(designators) + 1) As String
               designators(UBound(designators)) = letter & n
            End If
         Next
      End If
   Next
   For s = LBound(designators) To UBound(designators)
      rsDest.AddNew
      rsDest!Designator = rsSource!Designator
      rsDest!PN = rsSource!PN
      rsDest!Description = rsSource!Description
      rsDest!quantity = rsSource!quantity
      rsDest!Reference = Trim(designators(s))
   Next
   rsSource.MoveNext
Wend
rsDest.Update
End Sub

[ssanfu]

I import an Excel BOM into a new table.

What are the names of the tables and fields in the tables?

[Pat]

"Out of the box perfect"! Thank you so much. I didn't give you all my field names but your code was so easy to follow I simply added those remaining fields and it works perfectly. Thanks a ton for such a quick answer perfect answer.