Forum Discussion

  • Lorenzo's avatar
    Lorenzo
    Silver Contributor

    Hi Christian_Ecijan 

     

    Adding a Power Query option (attached) for the record as VBA is probably (much) faster

    let
        Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
        CustomDelim = ", ",
        AddedNextRefs = Table.AddColumn(Source, "NEXT_REFS", each
            if Text.Contains([Reference], CustomDelim)
            then Text.AfterDelimiter([Reference], CustomDelim)
            else null
        ),
        SplittedRefToRows = Table.ExpandListColumn(
            Table.TransformColumns(AddedNextRefs,
                {"Reference", Splitter.SplitTextByDelimiter(CustomDelim, QuoteStyle.Csv)}
            ),
            "Reference"
        ),
        AddedClusterIndex = Table.Group(SplittedRefToRows, {"Part Number"}, 
            {"DATA", each Table.AddIndexColumn(_, "IDX", 0, 1), type table}
        ),
        CombinedNestedTables = Table.Combine(AddedClusterIndex[DATA]),
        UpdatedQtyAndNextRefs = Table.ReplaceValue(CombinedNestedTables, each [IDX], null,
            (v,i,n)=> if i = 0 then v else null,
            {"Qty", "NEXT_REFS"}
        
        ),
        SplittedNextRefsToCols = Table.SplitColumn(UpdatedQtyAndNextRefs, "NEXT_REFS",
            Splitter.SplitTextByDelimiter(CustomDelim, QuoteStyle.Csv),
            List.Transform({2..List.Max(AddedNextRefs[Qty])}, each "Reference" & Text.From(_))
        ),
        RemovedIndex = Table.RemoveColumns(SplittedNextRefsToCols,{"IDX"}),
        RenamedRef = Table.RenameColumns(RemovedIndex, {{"Reference", "Reference1"}})
    in
        RenamedRef

    any question let me know

  • Christian_Ecijan 

    Sub parts()
    
    Dim i, j, k, m, n As Long
    
    Range("F:XFD").Clear
    k = Range("A" & Rows.Count).End(xlUp).Row
    m = 2
    
    For i = 2 To k
    For j = 1 To Cells(i, 3).Value
    Cells(m, 6).Value = Cells(i, 1).Value
    Cells(m, 7).Value = Cells(i, 2).Value
    
    If j = 1 Then
    Cells(m, 8).Value = Cells(i, 3).Value
    Else
    End If
    
    Cells(m, 9).Value = Left(Cells(i, 2).Value, 1) & j
    
    If j = 1 And Cells(i, 3).Value > 1 Then
    For n = 2 To Cells(i, 3).Value
    Cells(m, n + 8).Value = Left(Cells(i, 2).Value, 1) & n
    Next n
    
    Else
    End If
    
    m = m + 1
    
    Next j
    
    Next i
    
    End Sub

    In the attached file you can run the macro for the intended distribution of the data. However with a quantity of 16000 the result would be returned in columns H:WQR for this part number.

    • Christian_Ecijan's avatar
      Christian_Ecijan
      Copper Contributor
      Hi for this code, does it matter what Column I put the items?
      I dont think I will go over 16000 for quantity so it should be okay.
      Thanks
      • OliverScheurich's avatar
        OliverScheurich
        Gold Contributor

        Christian_Ecijan 

        You are welcome. The part number, description and quantity must be entered in columns A, B and C like in the sample file otherwise it wouldn't work. But of course the code can be adapted if required.

Resources