Cannot help without your current macro.
Thanks for the reply, but the macro contains proprietary info belonging to the place I work, with regards to the excel sheet format and part numbers, of which I cannot share.
Maybe you could put me on the right path or reference any macros, and I could work from there?
Also, when Monday comes, I'll try to make a generic version of the code, such that it's share-able.
In API help there is an example of how to find features in a folder: Get Contents of FeatureFolder Example (VBA).
(To get the component object of feature under the folder use Feature::GetSpecificFeature2)
Hope this helps.
Thanks, I'll see what I can come up with on Monday.
I have managed to get it to work with the following code below.
In short, I used the code to compile a line of Part numbers and stored it in a 2nd sheet Cell "A1".
Private Function KITLIST()
Dim swFeatMgr As SldWorks.FeatureManager
Dim swFeat As SldWorks.Feature
Dim swFeatFolder As SldWorks.FeatureFolder
Dim swFtrFolder As SldWorks.Feature
Dim FeatType As String
Dim FeatTypeName As String
Dim NbrOfFeatures As Long
Dim Features As Variant
Dim i As Long
Dim featureArr(2) As SldWorks.Feature
Dim featureObj As Variant
Set swFeatMgr = swModel.FeatureManager
Set xlsheet = xlBook.Worksheets("Sheet2")
xlCurRow = 1
Set swFeat = swModel.FirstFeature
Do While Not swFeat Is Nothing
FeatType = swFeat.Name
FeatTypeName = swFeat.GetTypeName2
Dim temp As Long
temp = InStr(1, FeatType, "EndTag", vbTextCompare)
If (FeatTypeName = "FtrFolder" And temp = 0 And FeatType = "KIT") Then
Set swFeatFolder = swFeat.GetSpecificFeature2
Features = swFeatFolder.GetFeatures
For i = 0 To (swFeatFolder.GetFeatureCount - 1)
Set swFtrFolder = Features(i)
xlsheet.Range("A" & xlCurRow).Value = swFtrFolder.Name & " , " & xlsheet.Range("A" & xlCurRow).Value
Set swFeat = swFeat.GetNextFeature
Set xlsheet = xlBook.Worksheets("Sheet1")
xlCurRow = 11
Then in my main code, I used the following to check if the part number in my main can be found in list in Sheet 2.
After which, I would have the "KIT" in my remarks column and also a "KIT" added to the part number
Dim CheckKIT As Integer
CheckKIT = InStr(1, xlBook.Worksheets("Sheet2").Range("A1"), swComp.Name, vbTextCompare)
If CheckKIT > 0 Then
xlsheet.Range("D" & xlCurRow).Value = xlsheet.Range("D" & xlCurRow).Value & " KIT"
xlsheet.Range("K" & xlCurRow).Value = "KIT " & xlsheet.Range("K" & xlCurRow).Value
xlsheet.Range("D" & xlCurRow).Value = xlsheet.Range("D" & xlCurRow).Value
xlsheet.Range("K" & xlCurRow).Value = xlsheet.Range("K" & xlCurRow).Value
xlCurRow = xlCurRow + 1
After my main code finishes listing every component in my main assembly, I would then delete the "KIT" from the part numbers with the following.
Dim LastRow5 As Long
LastRow5 = Range("D" & Rows.Count).End(xlUp).Row
xlCurRow = 11
For xlCurRow = 11 To LastRow5
xlsheet.Range("D" & xlCurRow).Value = Left(xlsheet.Range("D" & xlCurRow).Value, InStr(xlsheet.Range("D" & xlCurRow).Value, " K") - 1)
Hope I made sense with what I have above.
As long as you understand it, can troubleshoot it and it works the way you want then it makes perfect sense.