• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Production batch card with different part for one product.

Status
Not open for further replies.
Hi

I have created one batch card sheet for my regular productions as per the attached sheet Batch card old.
it is working well until the products have only one part as a below-left screenshot.

Now I have a product which is having 2, 3 and 4 parts of components in it.
So I want to change the code in the attached sheet.
expected batch card output as below right screenshot

The attached sheet Batch card partwise output I added manually. As per the cells C4 and E4 dropdown selection I need a batch card sheet to be prepared.
73481 73483
 

Attachments

  • Batch card old.xlsm
    95.4 KB · Views: 7
  • Batch card partwise.xlsm
    99.4 KB · Views: 11
Dear Marc L

Firstly I would like to thank you for your response.

Here I am explaining the Batch card old.xlsm how is working then we will come to know how the new sheet to be worked.
The left screenshot of the Formulation sheet is the base data where I will add all products formulations manually.
The right side screenshot is the Batch card for production which prepared by VBA as per the inputs of the cells F3(Date), C4(Product Name) and E4(Origin)
73508 73509

The below screen record linked file explains how the Batch card sheet changes as per the target cells value change

The VBA code is below FYI.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Select Case Target.Address
        Case "$F$3", "$C$4", "$E$4"
            ASE False
            f_tab = "Formulation"
            With Sheets("Batch Card")
                F_3 = .Range("F3")
                C_4 = .Range("C4")
                E_4 = .Range("E4")
            End With
            With Sheets(f_tab)
                f_max = .UsedRange.Rows(.UsedRange.Rows.Count).Row
                With .Range("A3:$N" & f_max)
                    .AutoFilter
                    .AutoFilter Field:=2, Criteria1:=C_4
                    .AutoFilter Field:=3, Criteria1:=E_4
                End With
                a_max = .Cells(.Rows.Count, "A").End(xlUp).Row
                If a_max < 4 Then
                    MsgBox "Cannot Find!", vbCritical, "Error!"
                    .Range("A3:$N" & f_max).AutoFilter
                    ASE True
                    Exit Sub
                End If
                a = a_max + 1
                Do
                    a = a - 1
                Loop Until (.Cells(a, 1).RowHeight > 0 And .Cells(a, 1) <= F_3) Or a <= 3
                a_max = a
                If a <= 3 Then
                    MsgBox "Cannot Find Proper Date!", vbCritical, "Error!"
                    ASE True
                    Exit Sub
                End If
            End With
            With Sheets("Batch Card")
                .Range("A7:E16").ClearContents
                a = 7
                x = 4
                Do
                    If Sheets(f_tab).Cells(a_max, x) <> Empty Then
                        .Cells(a, 1) = Sheets(f_tab).Cells(1, x)
                        .Cells(a, 2) = Sheets(f_tab).Cells(3, x)
                        .Cells(a, 5) = Sheets(f_tab).Cells(a_max, x)
                        a = a + 1
                    End If
                    x = x + 1
                Loop Until a >= 16 Or x >= 55
                .Range("A7:E16").Interior.ColorIndex = 20
                With Application
                    .ScreenUpdating = True
                    DoEvents
                End With
                .Range("A7:E16").Interior.ColorIndex = xlNone
            End With
            Sheets(f_tab).Range("A3:BN" & f_max).AutoFilter
    End Select
    ASE True
End Sub

Sub ASE(ss)
    With Application
        .EnableEvents = ss
        .ScreenUpdating = ss
    End With
End Sub
 
The Batch card partwise.xlsm have the new products which consist of 2, 3 and 4 components in one finished product.
Eg
Finished product Poxy 2k have two parts of Part-1 and Part-2
Finished product Poxy 3k have three parts of Part-1, Part-2 and Part-3
Finished product Poxy 4k have four parts of Part-1, Part-2, Part-3 and Part-4

In my first post, I have shown the output sample of Poxy 4k in the Batch Card sheet.

Now I will show the Poxy2k expected output as below

Poxy2k Base data from Formulation sheet
73512

Poxy2k 01-Feb-2019 date batch card sample below. Likewise, Changes of Date, Product Name, Origin, then the batch card need to be prepared by VBA Code
73511

Poxy3k Base data from Formulation sheet
73513

Poxy3k 06-Apr-2020 date batch card sample below. Likewise, Changes of Date, Product Name, Origin, then the batch card need to be prepared by VBA Code
73514



The below screenshot base data of products.
A - Date of creation
B - Product Name
C - Origin
D - Part Numbers
E - Part%

eg Row 37, Poxy4k has 4 part of products and each part % is 10-10-30-50
it means, To produce 10kg of Poxy4k, we need
Part-1 10% of 10kg is 1kg
Part-2 10% of 10kg is 1kg
Part-3 30% of 10kg is 30kg
Part-4 50% of 10kg is 50kg
73515


I hope the above explanation is understandable for you! if not please ask in detail, then again I try to explain in another way I can.
 
Why don't you use a button to launch the procedure rather than a worksheet event ?​
'Cause of the Formulation worksheet design we are at the border between an efficient code and a terrible gas factory one !​
Some concerns according to columns F:BE of Formulation :​
• all components for a part are always contiguous, never any blank within same color ?​
• There is always a blank at least between parts / colors ?​
If the answers are both positive so I can give it a try but if not I won't waste my time​
as the efficient procedure for positive answers must go to the trash if one becomes negative …​
 
Why don't you use a button to launch the procedure rather than a worksheet event ?'Cause of the Formulation worksheet design we are at the border between an efficient code and a terrible gas factory one !
Boss,
The Batch sheet old.xlsm VBA code I got someone from here in 3 to 4 years back. That time it was very excellent solution as all the products has only one part.

If that kind of code is not adequate for this new type of products which has many parts in one product, we can use any solutions, Also, I am ready to accept any restructure of data/input style/output format.

• all components for a part are always contiguous, never any blank within the same colour?
If there is no colour in F to BE then that product has only one part of components.
IF colour comes then that product has 2, 3 or 4 part components and never coloured cells will be blanks in my input
Each part we can fix any permanent colours like below
Part-1 Green
Part-2 Yellow
Part-3 Brown
Part-4 Blue
Each should be a different colour without blank cells.

• There is always a blank at least between parts / colors ?
It depends on the Products.
Eg
Poxy5k Product (In future not in the example file)
Part-1 RM2 and RM3
Part-2 RM4 and RM5
Part-3 RM6 and RM7
Part-4 RM8 and RM9
Part-5 RM10 and RM11
In this case, there is no space between parts to parts as RM's continues series, But the colours will surely differ from part to part.
 
As Excel was not designed to work by colors the easy & efficient way is space between parts which is not the case here​
so failing to the gas factory code side, now the cells of a part don't need anymore to be contiguous,​
maybe I will give it to a VBA beginner kid as a training …​
The reason why the most accurate attachment is N E C E S S A R Y in the initial post in order to not waste time of any helper !​
If I post any code according to the initial attachment and after the original poster changes the rules​
if I must trash my code to completely rewrite it 'cause of some information which must be in the initial post, I won't do it !​
So at least attach a workbook reflecting all the cases …​
 
But the colours will surely differ from part to part.
As the easy & fastest way to work with a block of contiguous cells for a part is not possible here​
the kid way is to work cell by cell with some helper columns like an Excel beginner using only worksheet formulas,​
the reason why with your design and this kind of procedure checking cell by cell the background color​
the cells of a part do not need anymore to be contiguous …​
 
Dear Marc L

Thanks for your suggestions.
I try to find some other way instead of colours.
As far as my knowledge I explained everything I needed
But, I don't know how to make one file that will give my output by formulas or VBA code (This is what I posted here)

Anyway thanks a lot for your time on my question.
 
Dear Marc L

The below details are enough to provide the code.

parts are selected in Formulation worksheet columns F: BE by background-colour
according to 3 criteria in columns A:C with parts % in column E.
 
Also, The rows in the batch card sheet to be adjusted according to the products parts.
Eg If only one part with 6 RM then 6 rows required
If 4 parts with 15 Rm then 15 Rows required.
 
So according to your initial attachment and your posts #14 & 15 the new event procedure :​
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim V, L&, F&, R&, W, C(), S$(), N%, X, K%

    Select Case Split(Target.Address, ":")(0)
           Case "$F$3", "$C$4", "$E$4"
           Case Else
                Exit Sub
    End Select

    With Application
        V = .Match("#", Me.UsedRange.Columns(1), 0):  If IsError(V) Then Beep: Exit Sub
        L = V - 5
       .EnableEvents = False

    With Range("A7:F" & L)
        .ClearContents
        .Columns(2).NumberFormat = "General"
        .Font.Bold = False
        .Interior.ColorIndex = xlNone
    End With

       .EnableEvents = True

        If [(A1>0)+(N(F3)=0)+ISBLANK(C4)+ISBLANK(E4)] Then
            If L > 8 Then [A:F].Rows(8).Resize(L - 8).Delete xlUp
            Exit Sub
        End If

    With Sheet1.[B1].CurrentRegion
        V = .Parent.Evaluate(Replace("IF({1},YEAR(A4:A#)&""¤""&B4:B#&""¤""&C4:C#)", "#", .Rows.Count))
        V = Application.Match([YEAR(F3)&"¤"&C4&"¤"&E4], V, 0):  If IsError(V) Then Beep: Exit Sub
        F = V + 3
        V = Evaluate("{" & Replace(.Cells(F, 5).Text, "-", ",") & "}"):  If IsError(V) Then Beep: Exit Sub

        With .Columns("F:BE")
            R = Application.Count(.Rows(F)):  If R = 0 Then Beep: Exit Sub
            W = Application.Index(.Value2, Array(1, 3, F), Evaluate("ROW(1:" & .Count & ")"))
            ReDim C(1 To UBound(V)), S(1 To UBound(V))

            For N = 1 To .Count
                If Application.IsNumber(W(N, 3)) Then
                    X = Application.Match(.Cells(F, N).Interior.Color, C, 0)

                    If IsError(X) Then
                        K = K + 1:  If K > UBound(V) Then Beep: Exit Sub
                        C(K) = .Cells(F, N).Interior.Color
                        S(K) = "{" & N
                    Else
                        S(X) = S(X) & ";" & N
                    End If
                End If
            Next
        End With
    End With

        If K < UBound(V) Then Beep: Exit Sub
       .EnableEvents = False
       .ScreenUpdating = False
        R = 6 + R - L + K * 2

        If R < 0 Then
            [A:F].Rows(L + R).Resize(-R).Delete xlUp
        ElseIf R Then
            [A:F].Rows(L).Resize(R).Insert xlDown
            [B7:D7].Copy Cells(L, 2).Resize(R)
        End If

        R = 7

    For N = 1 To K
        X = Evaluate(S(N) & "}")

        With Rows(R).Columns("A:E")
            .Font.Bold = True
            .Interior.Color = C(N)
            .Item("A:B") = Array("PART-" & N, V(N) & "%")
            .Item(5).Formula = "=A5*B" & R & "&"" kg """
        End With

        With Rows(R + 1).Resize(UBound(X)).Columns
            .Item("A:B").Value2 = Application.Index(W, X, [{1,2}])
            .Item(5).Value2 = Application.Index(W, X, 3)
            .Item(6).Formula = "=A$5*B$" & R & "*E" & R + 1 & "%"
        End With

        With Rows(R + 1 + UBound(X)).Columns("B:F")
            .Font.Bold = True
            .Item(1).Value2 = "Total PART-" & N
            .Item("D:E").Formula = "=SUM(E" & R + 1 & ":E" & .Row - 1 & ")"
             R = .Row + 1
        End With
    Next

       .ScreenUpdating = True
       .EnableEvents = True
    End With
End Sub
You should Like it !​
 
Boss,
~Awesome~
It is working perfectly. Thanks a lot for your valuable support.


Just small things need to take care of as below.
Row heights to be fixed whenever changing the products.
Also, Specification row heights to be fixed with the same.

After completing the parts You can see two cells in #Ref
One is an average of Each parts total % (Column E)
another one is the sum of each parts Quantity in kg (Column F)

73578 73577
 
On my side no #Ref error just using beginner level worksheet formulas !​
According to your picture in F20 it's the sum of F7:F18 divided by 2 (kid logic here) and in E20 it's obviously F20 divided by A5 multiplied by 100 …​
 
According to your attachment I can't reproduce your rows height issue with different Excel versions​
so try first to ajust manually the height (and formulas as well following my previous post) and test again different cases …​
 
If you still have an issue restart with the initial post attachment - as your picture shows that is not it - then​
paste the post #16 code to the worksheet module and retry …​
For any issue : well detail any operation you have made to the worksheet since the workbook opening in order I can try exactly the same.​
 
Status
Not open for further replies.
Back
Top