ThisBOM .export column order problem.

[tdipilla]

I have an iLogic routine using the ThisBOM.export function.  I am using the “parts only” format for my export.  The format that ends up in my excel file has the columns in alphabetical order based on the column header.   This is different than the layout in the part only view.  What drives the column order in the ThisBOM function and can it be altered or controlled? Thanks

[Anonymous]

Good grief you're fast!  Thanks - I've noticed this since I started, though, I can't dim and declare variables in one line:

Dim counter As Integer = 1

I have always redone it as:

dim counter as integer 

counter = 1

I normally ignore this, but maybe it's indicative that I have something set up wrong elsewhere.... ie: in the menu tools-references, I've added the Microsoft Excel 16.0 object library.  Might need another one, esp since this line won't compile:

Dim arrColOrder() As String = {"Item", "QTY", "Part Number", "Description", "Stock Number"}

Header row is row 1 as exported and slightly modified, so that is ok.

[MechMachineMan]

Good ol' vb.net to vba conversion!

Also, the lines that are commented out need to be put back in in place of their counterparts if you are using VBA.

https://stackoverflow.com/questions/2784592/vba-inline-array

[Anonymous]

That's what I figured re: the commented lines - didn't work for me either - I'll keep messing around with it and will get there.

[Anonymous]

I spent the rest of the morning reading, I completely fail to understand what I could possibly pass to the private sub beyond the file name and worksheet I want it to run on.  I have been trying to define excel app, worksheet, etc about 10 different ways, it does not seem to like anything I come up with.

So in the main body after defining all of my columns, I call the private sub:

Call ReorderXLBOM(excel_app, Sheet1 or xlws, or ????) - excel_app is already populated as "excel application," the others.. as a variable I set prior or as sheet 1 the string, or soft coded as activesheet.name, and set as a string.. or as an integer "1" etc, etc...

All of the sample code I find you're passing basic stuff like integers or strings, then the sub operates on these integers or strings and passes them back.  Usually they are passing to functions, not subs.  These values are later used in the private sub or function, here I don't see application used, unless that's what gets you into the "excel environment," so that the entire rest of the chunk of code is running there... I think I'm on to something with this.

What I find mind boggling is that I can't find much common ground between what I'm doing here and the reference stuff I look up, ie: books on VB I've paged through and examples I find online, ie: 

http://www.functionx.com/vbaexcel/functions/Lesson3.htm

Going for lunch, maybe that's why I can't think, need to take a few steps back when I return. 

 

...back, with some "food of the people" - Tim Hortons!  Not that great but closest geographically.  I re read this and I love how all of my posts now are in the voice of a struggling middle aged man!

[MechMachineMan]

Here is the sample that works exactly as-is in excel vba:

Sub Test()
    Dim xlApp As Application
    Dim xlwb As Workbook
    Dim xlws As Worksheet
 
  'Sample as it looks in excel vba  
    Set xlApp = Application
    Set xlwb = xlApp.ActiveWorkbook
    Set xlws = xlwb.Worksheets(1)

  'Sample as i'd imagine it would look in inventor.
    'Set xlApp = GetObject("", "Excel.Application")
    'Set xlwb = xlApp.Workbooks.Open(Filename:= "C:\Test.xlsx")
    'Set xlws = xlwb.Worksheets("Sheet1")
    
    Call ReorderXLBOM(xlApp, xlws, 1)

End Sub

Private Sub ReorderXLBOM(xlApp As Application, xlws As Worksheet, oHeaderRow As Integer)

    Dim arrColOrder, ndx, Found, counter
    arrColOrder = Array("Item", "QTY", "Part Number", "Description", "Stock Number", "Vendor", "CutLength", "DwgRev")
    
    counter = 1

  On Error Resume Next
    For ndx = LBound(arrColOrder) To UBound(arrColOrder)
        Set Found = xlws.Rows(oHeaderRow).Find(arrColOrder(ndx), , -4163, 1, 2, 1, False)
    
        If Not Found Is Nothing Then
                If Found.Column <> counter Then
                        Found.EntireColumn.Cut
                        xlws.Columns(counter).Insert -4161
                        Application.CutCopyMode = False
                End If
                counter = counter + 1
        End If
    Next
    
    If Err.Number <> 0 Then
            MsgBox ("Reorder Columns Rule Error: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
    End If
End Sub

[Anonymous]

Huh, I did not know you could dim a variable as a "worksheet," etc, I'm sure that's why I had type mismatch problems.  Then my hard coding I tried would have probably worked!

Thanks for your time today, Justin, invaluable as usual.

[Anonymous]

Did not have any luck, despite playing with syntax, getting the already existing excel object (the getobject ("","excel.application") line), so..save it all, close workbook and excel, create a new excel object with an arbitrarily different variable set, I left the row integer stuff out as that's always 1, call Reorder... still type mismatch.  xlws does not seem to be set to anything if I break and hover over it.

I know Set xlwb = xlapp.Workbooks.Open(bomname) works as I can set excel to visible and it pops up again.  I'm really hoping someone other than poor Justin has a look at this... but that doesn't seem to be a reality!

Public Sub LMExport()

'make a bunch of variables for file naming.
Dim temp As String
            Dim temper As String
            Dim basefilename As String
            Dim FullFileName As String
            Dim prefix As String
            Dim prefixer As String
            Dim bomname As String
            


' This code runs on assembly documents only

Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument

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

' Set the structured view to all levels
oBOM.StructuredViewFirstLevelOnly = False

' Set structured view
oBOM.StructuredViewEnabled = True

' Set ref to Structured BOM View
Dim oStructuredBOMView As BOMView
Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")

' Export the BOM view to an Excel file

prefix = oDoc.FullDocumentName

temper = Right$(prefix, Len(prefix) - InStrRev(prefix, "\"))

prefixer = Left(temper, Len(temper) - 4)

FullFileName = Left(oDoc.FullDocumentName, Len(oDoc.FullDocumentName) - 3) & "iam"

temp = Right$(FullFileName, Len(FullFileName) - InStrRev(FullFileName, "\"))
            
basefilename = Left$(temp, InStrRev(temp, ".") - 1)
            
'bomname = "C:\Users\Lean6\Google Drive\LeanMachineRev2-179269\MPS_Files_\" & basefilename & ".xls"
bomname = "C:\Temp\" & basefilename & ".xls"

oStructuredBOMView.Export bomname, kMicrosoftExcelFormat

'add first column
'On Error Resume Next
Set excel_app = CreateObject("Excel.Application")
excel_app.Visible = True
excel_app.Workbooks.Open (bomname)
Dim rows As Integer
Dim rowbottom As String
rows = excel_app.ActiveSheet.UsedRange.rows.Count
rowbottom = "A1" & ":" & "A" & rows
excel_app.Range("A1").EntireColumn.Insert
excel_app.Range(rowbottom) = "=TRIM(LEFT(SUBSTITUTE(MID(CELL(""filename"",A1),FIND(""["",CELL(""filename"",A1))+1,255),"".xl"",REPT("" "",255)),255))"
excel_app.ActiveWorkbook.Save
excel_app.ActiveWorkbook.Close
excel_app.Quit
Set excel_app = Nothing

    Dim xlwb As Workbook
    Dim xlws As WorkSheet

Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Open(bomname)
Set xlws = xlwb.Worksheets("Sheet1")

Call ReorderXLBOM(xlapp, xlws)

xlapp.ActiveWorkbook.Save
xlapp.ActiveWorkbook.Close
xlapp.Quit
Set xlapp = Nothing



End Sub



Private Sub ReorderXLBOM(ByVal xlapp As Application, ByVal xlws As WorkSheet)
    Dim ndx As Integer
    Dim Found As Range
    Dim counter As Integer
    counter = 1
      
    arrColOrder = Array("Order", "Item", "Part Number", "BOM Structure", "QTY", "Assembly Qty", "A1 Router", "A1 Time", "B1 Laser", "B1 Time", "C1 Saw-AL", "C1 Time", "D1 Saw-ST", "D1 Time", "E1 C-Axis", "E1 Time", "F1 Machining", "F1 Time", "G1 Debur", "G1 Time", "H1 Brake", "H1 Time", "I1 Weld", "I1 Time", "J1 RWeld", "J1 Time", "K1 Assembly", "K1 Time", "L1 Outsource", "L1 Time", "M1 Ship", "Bulk", "Setup")

    On Error Resume Next

    For ndx = LBound(arrColOrder) To UBound(arrColOrder)

        Set Found = xlws.rows("1:1").Find(arrColOrder(ndx), , LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
    
        If Err.Number <> 0 Then
            MsgBox ("Error With Excel FIND function: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
        End If

        If Not Found Is Nothing Then
                If Found.Column <> counter Then
                        Found.EntireColumn.Cut
                        xlws.Columns(counter).Insert (-4161)
                        excelapp.CutCopyMode = False
                End If
                counter = counter + 1
        End If
    Next
    
    If Err.Number <> 0 Then
            MsgBox ("Reorder Columns Rule Error: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
    End If
End Sub

[MechMachineMan]

I think you might be getting a little caught up on what the syntax might be instead of what the code is doing at a functional level.

"Does it make sense that I really need to create an excel app twice to open a file and change some columns?"

"Does it make sense that I pass a variable to a function, but don't modify it in any way?"

"Does it make sense that I have this variable used somewhere in my code, but don't ever assign anything to it?"

etc.

Public Sub LMExport()

'make a bunch of variables for file naming.
Dim temp As String
            Dim temper As String
            Dim basefilename As String
            Dim FullFileName As String
            Dim prefix As String
            Dim prefixer As String
            Dim bomname As String
            


' This code runs on assembly documents only

Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument

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

' Set the structured view to all levels
oBOM.StructuredViewFirstLevelOnly = False

' Set structured view
oBOM.StructuredViewEnabled = True

' Set ref to Structured BOM View
Dim oStructuredBOMView As BOMView
Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")

' Export the BOM view to an Excel file

prefix = oDoc.FullDocumentName

temper = Right$(prefix, Len(prefix) - InStrRev(prefix, "\"))

prefixer = Left(temper, Len(temper) - 4)

FullFileName = Left(oDoc.FullDocumentName, Len(oDoc.FullDocumentName) - 3) & "iam"

temp = Right$(FullFileName, Len(FullFileName) - InStrRev(FullFileName, "\"))
            
basefilename = Left$(temp, InStrRev(temp, ".") - 1)
            
'bomname = "C:\Users\Lean6\Google Drive\LeanMachineRev2-179269\MPS_Files_\" & basefilename & ".xls"
bomname = "C:\Temp\" & basefilename & ".xls"

oStructuredBOMView.Export bomname, kMicrosoftExcelFormat

Dim xlwb As Workbook
Dim xlws As WorkSheet

Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Open(bomname)

'might need to change the sheet name depending on what the export function outputs.
Set xlws = xlwb.Worksheets("Sheet1")


Dim rows As Integer
Dim rowbottom As String
rows = xlws.UsedRange.rows.Count
rowbottom = "A1" & ":" & "A" & rows
xlws.Range("A1").EntireColumn.Insert
xlws.Range(rowbottom) = "=TRIM(LEFT(SUBSTITUTE(MID(CELL(""filename"",A1),FIND(""["",CELL(""filename"",A1))+1,255),"".xl"",REPT("" "",255)),255))"
xlwb.Save

Call ReorderXLBOM(xlapp, xlws)

xlwb.Save
xlApp.Quit
Set xlws = nothing
Set xlwb = Nothing
Set xlApp = Nothing

End Sub

Private Sub ReorderXLBOM(ByVal xlapp As Application, ByVal xlws As WorkSheet)
    Dim ndx As Integer
    Dim Found As Range
    Dim counter As Integer
    counter = 1
      
    arrColOrder = Array("Order", "Item", "Part Number", "BOM Structure", "QTY", "Assembly Qty", "A1 Router", "A1 Time", "B1 Laser", "B1 Time", "C1 Saw-AL", "C1 Time", "D1 Saw-ST", "D1 Time", "E1 C-Axis", "E1 Time", "F1 Machining", "F1 Time", "G1 Debur", "G1 Time", "H1 Brake", "H1 Time", "I1 Weld", "I1 Time", "J1 RWeld", "J1 Time", "K1 Assembly", "K1 Time", "L1 Outsource", "L1 Time", "M1 Ship", "Bulk", "Setup")

    On Error Resume Next

    For ndx = LBound(arrColOrder) To UBound(arrColOrder)

        Set Found = xlws.rows("1:1").Find(arrColOrder(ndx), , LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
    
        If Err.Number <> 0 Then
            MsgBox ("Error With Excel FIND function: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
        End If

        If Not Found Is Nothing Then
                If Found.Column <> counter Then
                        Found.EntireColumn.Cut
                        xlws.Columns(counter).Insert (-4161)
                        excelapp.CutCopyMode = False
                End If
                counter = counter + 1
        End If
    Next
    
    If Err.Number <> 0 Then
            MsgBox ("Reorder Columns Rule Error: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
    End If
End Sub

[Anonymous]

Of course, a lot of what I did makes no sense at all -  It seemed like keeping things discrete would have helped me figure it out or at least got the code running, ie: I'd get an error: here is your problem with variable x.  I find it interesting that the original code didn't use something like the xlws variable, just used excel_app.activesheet, I was finding out reading samples/comments that these sorts of call outs can get fooled one way or another.  My logic breaks down when I don't realize that this relationship is possible in the first place, so it's nice to see it here - I know it's probably frustrating since it's completely transparent to you!

If you're referring a few of the name aggregation variables as being extraneous, those lines are (theoretically,) active in a different sub I use, it all has to get trimmed down and fixed once I figure out where this is going to get saved and how... I guess I might as well do housekeeping on the fly in the future or at least comment some things out.

Thanks!

[MechMachineMan]

Be careful with comments though! Comments can be a devil and often add nothing except length and confusion to the code. The best code is generally the stuff that is easiest to read. Multiple sources I've looked at have always suggested only commenting HOW and not WHAT. In vb this is especially true as things are verbose enough to read it almost like plain English, or generally get away with making assumptions.

' This code runs on assembly documents only

Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument

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

' Set the structured view to all levels
oBOM.StructuredViewFirstLevelOnly = False

' Set structured view
oBOM.StructuredViewEnabled = True

' Set ref to Structured BOM View
Dim oStructuredBOMView As BOMView
Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")

 The comments above don't really add anything; they just reorganize the words in the following line. Not really necessary when you can generally decipher meaning from the line below.

Something like this, however is generally needed:

'Get File Name -- ex: "C:\test\test1.iam" -> "C:\test\"
temper = Right$(prefix, Len(prefix) - InStrRev(prefix, "\"))

The comment makes it super straight forward as to what it expects and what it returns, instead of trying to have to figure out what each arithmetic operation is doing.

Let me know if you have any more issues with the code!

[Anonymous]

heh, what's ironic is I had the comments  you mentioned taken out - blew away/saved over/otherwise lost my code and then copied it back out of either this thread or another one, or maybe even my backups 😉 and forgot to remove them again.   I will change up how I do this in the future, there's some more to be done here...

I'm concerned I'm beating my head against the wall with some unrelated problem - I still get type mismatch at the Call ReorderXLBOM(xlapp,xlws) line.

I now know that the xlws variable is working as I successfully add and rename the columns.

Public Sub LMExport()

'make a bunch of variables for file naming.
Dim temp As String
Dim basefilename As String
Dim FullFileName As String
Dim bomname As String
            
'set up
Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oBOM As BOM
Set oBOM = oDoc.ComponentDefinition.BOM

'setting all levels
oBOM.StructuredViewFirstLevelOnly = False
oBOM.StructuredViewEnabled = True

' Set ref to Structured BOM View
Dim oStructuredBOMView As BOMView
Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")

' Export

FullFileName = Left(oDoc.FullDocumentName, Len(oDoc.FullDocumentName) - 3) & "iam"

temp = Right$(FullFileName, Len(FullFileName) - InStrRev(FullFileName, "\"))
            
basefilename = Left$(temp, InStrRev(temp, ".") - 1)
            
'bomname = "C:\Users\Lean6\Google Drive\LeanMachineRev2-179269\MPS_Files_\" & basefilename & ".xls"
bomname = "C:\Temp\" & basefilename & ".xls"

oStructuredBOMView.Export bomname, kMicrosoftExcelFormat

Dim xlwb As Workbook
Dim xlws As WorkSheet
Set xlapp = CreateObject("Excel.Application")
xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Open(bomname)
Set xlws = xlwb.Worksheets("Sheet1")

Dim rows As Integer
Dim rowbottom As String
rows = xlws.UsedRange.rows.Count
rowbottom = "A1" & ":" & "A" & rows
xlws.Range("A1").EntireColumn.Insert
xlws.Range(rowbottom) = "=TRIM(LEFT(SUBSTITUTE(MID(CELL(""filename"",A1),FIND(""["",CELL(""filename"",A1))+1,255),"".xl"",REPT("" "",255)),255))"
xlws.Range("A1") = "Order"
xlws.Range("F1").EntireColumn.Insert
xlws.Range("F1") = "Assembly Qty"

Call ReorderXLBOM(xlapp, xlws)

xlwb.Save
xlapp.Quit
Set xlws = Nothing
Set xlwb = Nothing
Set xlapp = Nothing

End Sub



Private Sub ReorderXLBOM(ByVal xlapp As Application, ByVal xlws As WorkSheet)
    Dim ndx As Integer
    Dim Found As Range
    Dim counter As Integer
    counter = 1
      
    arrColOrder = Array("Order", "Item", "Part Number", "BOM Structure", "QTY", "Assembly Qty", "A1 Router", "A1 Time", "B1 Laser", "B1 Time", "C1 Saw-AL", "C1 Time", "D1 Saw-ST", "D1 Time", "E1 C-Axis", "E1 Time", "F1 Machining", "F1 Time", "G1 Debur", "G1 Time", "H1 Brake", "H1 Time", "I1 Weld", "I1 Time", "J1 RWeld", "J1 Time", "K1 Assembly", "K1 Time", "L1 Outsource", "L1 Time", "M1 Ship", "Bulk", "Setup")

    On Error Resume Next

    For ndx = LBound(arrColOrder) To UBound(arrColOrder)

        Set Found = xlws.rows("1:1").Find(arrColOrder(ndx), , LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
    
        If Err.Number <> 0 Then
            MsgBox ("Error With Excel FIND function: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
        End If

        If Not Found Is Nothing Then
                If Found.Column <> counter Then
                        Found.EntireColumn.Cut
                        xlws.Columns(counter).Insert (-4161)
                        excelapp.CutCopyMode = False
                End If
                counter = counter + 1
        End If
    Next
    
    If Err.Number <> 0 Then
            MsgBox ("Reorder Columns Rule Error: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
    End If
End Sub

[MechMachineMan]

If it was something within in the sub, it would likely flag that line. So we can tell that it's likely the function call, or the line where we establish what the function is/does.

In this case, Vba and function calls sometimes get fussy if things aren't declared - like I missed in my code. 

Dim xlApp As Application should get you closer, or as Excel.Application, or as Variant, or Object.

[Anonymous]

I had the xlapp defined at several points along the way, dim xlapp as ... something, but it seemed superfluous and possibly wouldn't work, was probably declaring it as the wrong type of variable.

[Anonymous]

I just did some good reading about the end of vba, how it will be the cobol of yesteryear, how you'll have vba to .net conversion experts who can save businesses with a big infrastructure set up in vba - very interesting!  Was posted 10 years ago.

Variant can hold anything, and I think it would come in handy to know how to call subroutines in the future, but I never could get the function call to work, so I gave up.  Not really harmful, just kind of a hollow victory. 😕   If anything, I am going to be looking into .net a lot more, and knowing more about it will probably help me with these issues as the languages are so similar.  At least, they seem to be.

Public Sub LMExport()
        
'set up
Dim oDoc As AssemblyDocument
Set oDoc = ThisApplication.ActiveDocument
Dim oBOM As BOM
Set oBOM = oDoc.ComponentDefinition.BOM
oBOM.StructuredViewFirstLevelOnly = False
oBOM.StructuredViewEnabled = True
Dim oStructuredBOMView As BOMView
Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")

'Export
Dim temp As String
Dim basefilename As String
Dim FullFileName As String
Dim bomname As String

    FullFileName = Left(oDoc.FullDocumentName, Len(oDoc.FullDocumentName) - 3) & "iam"
    temp = Right$(FullFileName, Len(FullFileName) - InStrRev(FullFileName, "\"))
    basefilename = Left$(temp, InStrRev(temp, ".") - 1)
            
'bomname = "C:\Users\Lean6\Google Drive\LeanMachineRev2-179269\MPS_Files_\" & basefilename & ".xls"
bomname = "C:\Temp\" & basefilename & ".xls"

    oStructuredBOMView.Export bomname, kMicrosoftExcelFormat

'Edit spreadsheet

Dim xlwb As Workbook
Dim xlws As WorkSheet
Dim xlapp As Variant
Set xlapp = CreateObject("Excel.Application")
'xlapp.Visible = True
Set xlwb = xlapp.Workbooks.Open(bomname)
Set xlws = xlwb.Worksheets(1)

Dim rows As Integer
Dim rowbottom As String
rows = xlws.UsedRange.rows.Count
rowbottom = "A1" & ":" & "A" & rows
xlws.Range("A1").EntireColumn.Insert
xlws.Range(rowbottom) = "=TRIM(LEFT(SUBSTITUTE(MID(CELL(""filename"",A1),FIND(""["",CELL(""filename"",A1))+1,255),"".xl"",REPT("" "",255)),255))"
xlws.Range("A1") = "Order"
xlws.Range("F1").EntireColumn.Insert
xlws.Range("F1") = "Assembly Qty"

'reordering
    Dim ndx As Integer
    Dim Found As Range
    Dim counter As Integer
    counter = 1
      
        arrColOrder = Array("Order", "Item", "Part Number", "BOM Structure", "QTY", "Assembly Qty", "A1 Router", "A1 Time", "B1 Laser", "B1 Time", "C1 Saw-AL", "C1 Time", "D1 Saw-ST", "D1 Time", "E1 C-Axis", "E1 Time", "F1 Machining", "F1 Time", "G1 Debur", "G1 Time", "H1 Brake", "H1 Time", "I1 Weld", "I1 Time", "J1 RWeld", "J1 Time", "K1 Assembly", "K1 Time", "L1 Outsource", "L1 Time", "M1 Ship", "Bulk", "Setup")

        On Error Resume Next

    For ndx = LBound(arrColOrder) To UBound(arrColOrder)

        Set Found = xlws.rows("1:1").Find(arrColOrder(ndx), , LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
    
        If Err.Number <> 0 Then
            MsgBox ("Error With Excel FIND function: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
        End If

        If Not Found Is Nothing Then
                If Found.Column <> counter Then
                        Found.EntireColumn.Cut
                        xlws.Columns(counter).Insert (-4161)
                        xlapp.CutCopyMode = False
                End If
                counter = counter + 1
        End If
    Next
    
    If Err.Number <> 0 Then
            MsgBox ("Reorder Columns Rule Error: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
    End If

xlwb.Save
xlapp.Quit
Set xlws = Nothing
Set xlwb = Nothing
Set xlapp = Nothing

End Sub

[MechMachineMan]

Here is a quick tweak of the version. Ran it through the VBA editor and realized it was just the reference that was missing as this is coded using EARLY BINDING so it operates faster.

Also tweaked the BOM call as I realized I don't have to pass the application directly and can just get it from the worksheet.

'BOM Export & Column Reorder -- For use in INVENTOR VBA Environment


'NOTE: Add Reference to the latest Microsoft Excel Object Library in the 'VBA Editor>Tools>References' 
'       as this vba code is written with EARLY BINDING.


Public Sub LMExport()

    Dim temp As String
    Dim basefilename As String
    Dim FullFileName As String
    Dim bomname As String
     
    Dim oDoc As AssemblyDocument
    Set oDoc = ThisApplication.ActiveDocument
    Dim oBOM As BOM
    Set oBOM = oDoc.ComponentDefinition.BOM

    oBOM.StructuredViewFirstLevelOnly = False
    oBOM.StructuredViewEnabled = True

    Dim oStructuredBOMView As BOMView
    Set oStructuredBOMView = oBOM.BOMViews.Item("Structured")

    'Why?
    FullFileName = Left(oDoc.FullDocumentName, Len(oDoc.FullDocumentName) - 3) & "iam"

    'base file name with ext
    temp = Right$(FullFileName, Len(FullFileName) - InStrRev(FullFileName, "\"))
            
    'base file name no ext
    basefilename = Left$(temp, InStrRev(temp, ".") - 1)
                
    'bomname = "C:\Users\Lean6\Google Drive\LeanMachineRev2-179269\MPS_Files_\" & basefilename & ".xls"
    bomname = "C:\Temp\" & basefilename & ".xls"

    oStructuredBOMView.Export bomname, kMicrosoftExcelFormat
    
    Dim xlApp As Excel.Application
    Dim xlwb As Workbook
    Dim xlws As WorkSheet
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = True
    
    Set xlwb = xlApp.Workbooks.Open(bomname)
    Set xlws = xlwb.Worksheets("Sheet1")

    Dim rows As Integer
    Dim rowbottom As String
    rows = xlws.UsedRange.rows.Count
    rowbottom = "A1" & ":" & "A" & rows
    xlws.Range("A1").EntireColumn.Insert
    xlws.Range(rowbottom) = "=TRIM(LEFT(SUBSTITUTE(MID(CELL(""filename"",A1),FIND(""["",CELL(""filename"",A1))+1,255),"".xl"",REPT("" "",255)),255))"
    xlws.Range("A1") = "Order"
    xlws.Range("F1").EntireColumn.Insert
    xlws.Range("F1") = "Assembly Qty"

    Call ReorderXLBOM(xlws)

    xlwb.Save
    xlApp.Quit
    Set xlws = Nothing
    Set xlwb = Nothing
    Set xlApp = Nothing

End Sub

Private Sub ReorderXLBOM(ByVal xlws As WorkSheet)
    Dim ndx As Integer
    Dim Found As Range
    Dim counter As Integer
    counter = 1
      
    arrColOrder = Array("Order", "Item", "Part Number", "BOM Structure", "QTY", "Assembly Qty", "A1 Router", "A1 Time", "B1 Laser", "B1 Time", "C1 Saw-AL", "C1 Time", "D1 Saw-ST", "D1 Time", "E1 C-Axis", "E1 Time", "F1 Machining", "F1 Time", "G1 Debur", "G1 Time", "H1 Brake", "H1 Time", "I1 Weld", "I1 Time", "J1 RWeld", "J1 Time", "K1 Assembly", "K1 Time", "L1 Outsource", "L1 Time", "M1 Ship", "Bulk", "Setup")

    On Error Resume Next

    For ndx = LBound(arrColOrder) To UBound(arrColOrder)

        Set Found = xlws.rows("1:1").Find(arrColOrder(ndx), , LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        
        If Err.Number <> 0 Then
            MsgBox ("Error With Excel FIND function: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
        End If

        If Not Found Is Nothing Then
                If Found.Column <> counter Then
                        Found.EntireColumn.Cut
                        xlws.Columns(counter).Insert (-4161)
                        xlws.Application.CutCopyMode = False
                End If
                counter = counter + 1
        End If
    Next
    
    If Err.Number <> 0 Then
            MsgBox ("Reorder Columns Rule Error: " & Err.Number & " :: " & Err.Description & vbLf & vbLf & ndx)
            Err.Clear
    End If
End Sub

[Anonymous]

I'm sure I had this exact setup going (had taken out the byval xlapp as application part of the call,) and I've always had the excel object loaded, but your version works and mine did not so... haha!

Thanks, Justin!

I think that full file name take apart and then reassemble is in there so I can change the extension if I want to.  Not necessary in this one as It's going to excel, but in the one I made to save .png's it's used.

[J_Dumont]

It appears the problem still persists.

The code above looks great but I have a question. I have various users and they might have different columns.

My code reads a user-defined XML file that was created using the BOM Export function.

Is it possible to read the file to determine the order of the fields?