Repeating part # in one column; in adjacent column, need to count the # of production units.

[nearbeer]

Thank you for your time to view my question.

I have production data that will list component part #s as well as production part #in one column (Product Code in table below); in the adjacent column, the serial number of each component and production unit is listed (Barcode Serial Number). Whenever we replenish a box of components used in the production process, we scan a ticket with the part number but has a different serial number from box to box.

I am trying to devise a way to count the number of serial #s between the same component #s; here is a sample of my data. BTW, I've tried a pivot table but it gives only an average; I need count of serial numbers so that I can get a range of how many units are produced between boxes.

Scan Date	Operation Type	Product Code	Machine #	Workpost #	Barcode Serial Number
09/19/2014 23:49	CA	CARCJ80S2586	S2	F01	58625478
09/19/2014 23:49	CA	CARCAF0T1658	T1	F01	65804077
09/19/2014 23:28	CA	CARCAF0T1658	T1	F01	65804076
09/19/2014 23:29	CA	CARCJ80S2586	S2	F01	58625477
09/19/2014 23:31	<acronym title="Google Page Ranking">PR</acronym>	FECX187029	S2	FEX	17092014-A85
…	…	…	…	…	…
…	…	…	…	…	…
09/19/2014 22:58	CA	CARCAF0T1658	T1	F01	65804070
09/19/2014 16:29	CA	CARC9L0S2688	S2	F01	68850901
09/19/2014 16:23	CA	CARC9L0S2688	S2	F01	68850900
09/19/2014 16:20	CA	CARCAF0T1658	T1	F01	65804012
09/19/2014 16:24	<acronym title="Google Page Ranking">PR</acronym>	FECX166884	S2	FEX	18092014-D14

<tbody>
</tbody>

I am working with several thousand lines of data; any and all help is greatly appreciated!

Thanks and always in search of my next cold one,

NearBeer

 

[Fazza]

Hello, NearBeer. The requirement is unclear. Please try again to simply explain what is required - relative to the posted sample data? regards, Fazza

 

[nearbeer]

Sorry for the confusion. If I look in column "Operation Type" and see "PR", this tells me that I had to refill the machine with a certain assembly component. There are different workposts; in this case, I have two occurrences of "PR" and the component was "FE" for the same machine ("S2"). I want to be able to count the number of barcodes on "S2" between the refills of "FE".

I am at a roadblock because in the lines of data, I can have 29 unique values for "Machine #" and 8 unique values for "Workpost"; this makes for a lot of combinations that I just don't know how to throw out if I just want to count how many barcodes b/w one component on one machine.

Thanks,

NearBeer

 

[Fazza]

Thank you, NearBeer.

There are several thousand rows of production data. I have a - partial, and maybe adequate - understanding of the count required.

What are the inputs & outputs for this question?

Such as, explain the steps of
- start with the production data (only) and create a report that looks like ...describe. OR,
- start with the production data and also some other data, which needs to be described, and create the output

Either way, explain the steps that are followed.

OK?

 

[Fazza]

PS. In recent years, my favourite style is the Bavarian HefeWeiße. Whilst enjoying the classic Weihenstephan Age Check | Weihenstephaner brew I've really loved the Schneider Weisse Tap 4 version,
Loading...

It is my current favourite. Beautiful.

Last year in Poland I enjoyed Ciechan

 

[nearbeer]

Fazza,

Thanks for your assistance. The two variables I want to focus on is "Machine #" and the first two letters of "Workpost #" or "Product Code".

I would want this report to give me by machine number how many units were produced between refills. There are about 5 to 6 separate components that go into a unit. No two components are refilled at the same time. For example, we should get theoretically about 27 units per box of "FE" and about 40 out of another component called "TF".

So, an operator may start their shift by making 12 units before having to change out "FE." Then, maybe 20 units later, they have to change "TF." We make our own boxes of FE and TF in house; sometimes we get a bad batch of raw materials and the effect will show up downstream. What I am trying to do is figure out the range of units that we are getting per box of FE, TF, etc. By brute force data crunching, I have seen production runs between FE changes be as low as 14 and as high as 31; however, this was over a 4 day period and I didn't get the minimum 30 data points I am looking for...not to mention how slow it was slogging through lines of the mdb query.

If you don't mind, can I send you a sample table of the data I am working with? I had to really pare down the data to fit into the forum post; if you were to see a sample of the table returned from my mdb query, I think it will help my explanation.

BTW...my goal within the next 4 years is to visit Poland to see some of the Holocaust sites as well as other parts of Europe. I lived in the Philippines back in the 80's when my dad was in the military so I saw a fair amount of the Far East but now I am ready to see Europe.

Ciao,

NearBeer

 

[Fazza]

Posting me data is not preferred. Let me see what I can come up with from what you've posted already. I should have an opportunity today.

[BTW, with the data in an mdb file there might be better approaches that don't work on data in Excel worksheets. If working from Excel, VBA could query the mdb file returning a recordset through which one could loop and determine the desired results.]

 

[Fazza]

hello, again

If you want instructions on using the code, please ask. Back-up your file before testing. Before running the code, activate the worksheet with data &, if required, change the constants at the top of the code. A new standalone report file should be created by the code. It may not be clear what the code is doing: it may not be too efficient, either: it is just an approach I took & seems to me to do what you want. If not, can you modify as required? regards

Option Explicit

Sub NearBeer()


    Const lngCol_SCAN_DATE As Long = 1
    Const lngCol_OPERATION_TYPE As Long = 2
    Const lngCol_PRODUCT_CODE As Long = 3
    Const lngCol_MACHINE_ID As Long = 4


    Const str_REFILL_CODE_IDENTIFIER As String = "PR"


    Dim i As Long, j As Long, k As Long
    Dim lngRowsInNewArray As Long
    Dim lngMatchRow As Long
    Dim strCode As String
    Dim strScanDateFormat As String
    Dim wbkNew As Excel.Workbook
    Dim arIn As Variant
    Dim arOut(1 To 50000, 1 To 5) As Variant
    Dim arRows As Variant
    Dim objDic As Object


    arIn = Range("A1").CurrentRegion
    strScanDateFormat = Range("A2").NumberFormat


    'Loop through base data and create new array of refill data
    For i = 2 To UBound(arIn, 1)
        If arIn(i, lngCol_OPERATION_TYPE) = str_REFILL_CODE_IDENTIFIER Then
            j = j + 1
            arOut(j, 1) = arIn(i, lngCol_MACHINE_ID)
            arOut(j, 2) = Left$(arIn(i, lngCol_PRODUCT_CODE), 2)
            arOut(j, 3) = i
        End If
    Next i


    'Exit if no refill data identified
    If j = 0 Then Exit Sub


    lngRowsInNewArray = j


    Set objDic = CreateObject("Scripting.Dictionary")
    'Loop through refill data and create list of unique combinations of Machines & Products
    'and the data row numbers too
    For i = LBound(arOut, 1) To lngRowsInNewArray
        strCode = arOut(i, 1) & "|" & arOut(i, 2)
        If objDic.exists(strCode) Then
            objDic.Item(strCode) = Join$(Array(objDic.Item(strCode), arOut(i, 3)), "|")
        Else
            arOut(i, 3) = arOut(i, 3)
            objDic.Add strCode, arOut(i, 3)
        End If
    Next i


    'Loop through each record of the output array and populate the desired count
    For i = LBound(arOut, 1) To lngRowsInNewArray


        strCode = arOut(i, 1) & "|" & arOut(i, 2)
        arRows = Split(objDic.Item(strCode), "|")
        lngMatchRow = Application.WorksheetFunction.Match(CStr(arOut(i, 3)), arRows, 0)


        If lngMatchRow = 1 Then
            arOut(i, 3) = "first"
        Else
            k = 0
            For j = CLng(arRows(lngMatchRow - 2)) + 1 To CLng(arRows(lngMatchRow - 1)) - 1
                'Loop through source data and count records since previous refill for this machine
                If arIn(j, lngCol_MACHINE_ID) = arOut(i, 1) Then
                    If Not arIn(j, lngCol_OPERATION_TYPE) = str_REFILL_CODE_IDENTIFIER Then
                        k = k + 1
                    End If
                End If
            Next j
            arOut(i, 3) = k
            arOut(i, 4) = arIn(CLng(arRows(lngMatchRow - 2)), lngCol_SCAN_DATE)
            arOut(i, 5) = arIn(CLng(arRows(lngMatchRow - 1)), lngCol_SCAN_DATE)
        End If
    Next i
    Set objDic = Nothing
    Erase arRows, arIn


    'Output
    Set wbkNew = Workbooks.Add(Template:=xlWBATWorksheet)
    With wbkNew.Worksheets(1)
        With .Range("A1:E1")
            .Value2 = Array("Machine", "Product_Type", "Count", "From", "To")
            .Font.Bold = True
            .Interior.ColorIndex = 6
        End With
        .Columns("D:E").NumberFormat = strScanDateFormat
        .Range("A2").Resize(lngRowsInNewArray, UBound(arOut, 2)).Value2 = arOut
        Erase arOut
        .Range("A1").AutoFilter
        .Range("A1").AutoFilter Field:=3, Criteria1:="first"
        With .Range("A1").CurrentRegion
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .EntireColumn.AutoFit
        End With
        .Range("A1").AutoFilter
    End With
    Set wbkNew = Nothing
End Sub

 

[Fazza]

A minor modification. Overnight I thought about the little step that formats the scan date field. I'd take a lazy short-cut while coding. Revised code below amends & should be used in place of previous code. cheers

Sub NearBeer()

    Const lngCol_SCAN_DATE As Long = 1
    Const lngCol_OPERATION_TYPE As Long = 2
    Const lngCol_PRODUCT_CODE As Long = 3
    Const lngCol_MACHINE_ID As Long = 4


    Const str_REFILL_CODE_IDENTIFIER As String = "PR"


    Dim i As Long, j As Long, k As Long
    Dim lngRowsInNewArray As Long
    Dim lngMatchRow As Long
    Dim strCode As String
    Dim wbkNew As Excel.Workbook
    Dim arIn As Variant
    Dim arOut(1 To 50000, 1 To 5) As Variant
    Dim arRows As Variant
    Dim objDic As Object


    arIn = Range("A1").CurrentRegion


    'Loop through base data and create new array of refill data
    For i = 2 To UBound(arIn, 1)
        If arIn(i, lngCol_OPERATION_TYPE) = str_REFILL_CODE_IDENTIFIER Then
            j = j + 1
            arOut(j, 1) = arIn(i, lngCol_MACHINE_ID)
            arOut(j, 2) = Left$(arIn(i, lngCol_PRODUCT_CODE), 2)
            arOut(j, 3) = i
        End If
    Next i


    'Exit if no refill data identified
    If j = 0 Then Exit Sub


    lngRowsInNewArray = j


    Set objDic = CreateObject("Scripting.Dictionary")
    'Loop through refill data and create list of unique combinations of Machines & Products
    'and the data row numbers too
    For i = LBound(arOut, 1) To lngRowsInNewArray
        strCode = arOut(i, 1) & "|" & arOut(i, 2)
        If objDic.exists(strCode) Then
            objDic.Item(strCode) = Join$(Array(objDic.Item(strCode), arOut(i, 3)), "|")
        Else
            arOut(i, 3) = arOut(i, 3)
            objDic.Add strCode, arOut(i, 3)
        End If
    Next i


    'Loop through each record of the output array and populate the desired count
    For i = LBound(arOut, 1) To lngRowsInNewArray


        strCode = arOut(i, 1) & "|" & arOut(i, 2)
        arRows = Split(objDic.Item(strCode), "|")
        lngMatchRow = Application.WorksheetFunction.Match(CStr(arOut(i, 3)), arRows, 0)


        If lngMatchRow = 1 Then
            arOut(i, 3) = "first"
        Else
            k = 0
            For j = CLng(arRows(lngMatchRow - 2)) + 1 To CLng(arRows(lngMatchRow - 1)) - 1
                'Loop through source data and count records since previous refill for this machine
                If arIn(j, lngCol_MACHINE_ID) = arOut(i, 1) Then
                    If Not arIn(j, lngCol_OPERATION_TYPE) = str_REFILL_CODE_IDENTIFIER Then
                        k = k + 1
                    End If
                End If
            Next j
            arOut(i, 3) = k
            arOut(i, 4) = arIn(CLng(arRows(lngMatchRow - 2)), lngCol_SCAN_DATE)
            arOut(i, 5) = arIn(CLng(arRows(lngMatchRow - 1)), lngCol_SCAN_DATE)
        End If
    Next i
    Set objDic = Nothing
    Erase arRows, arIn


    'Output
    Set wbkNew = Workbooks.Add(Template:=xlWBATWorksheet)
    With wbkNew.Worksheets(1)
        With .Range("A1:E1")
            .Value2 = Array("Machine", "Product_Type", "Count", "From", "To")
            .Font.Bold = True
            .Interior.ColorIndex = 6
        End With
        .Columns("D:E").NumberFormat = "d/mm/yyyy h:mm"
        .Range("A2").Resize(lngRowsInNewArray, UBound(arOut, 2)).Value2 = arOut
        Erase arOut
        .Range("A1").AutoFilter
        .Range("A1").AutoFilter Field:=3, Criteria1:="first"
        With .Range("A1").CurrentRegion
            .Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
            .EntireColumn.AutoFit
        End With
        .Range("A1").AutoFilter
    End With
    Set wbkNew = Nothing
End Sub