Home > Blockchain >  Consolidate orders to single row counting number of orders and averaging the result
Consolidate orders to single row counting number of orders and averaging the result

Time:01-17

enter image description here

Each row is a separate order for a part. I need to count how many of each order so I can calculate the average parts ordered which is the quantity of each order. I have many rows and would like a formula or vba suggestions on how to automate this.

Once I get the number of orders and calculate the average parts per order I then must present the result in a single line eliminating all the separate order lines now that I have the average per order filled in.

I am looking for direction on the best method to achieve this. Thanks for your time and consideration.

This is a WIP but at this stage I don't know if VBA is the only way to accomplish what I need. I was trying to build a range based on the part name being the same. A couple issues is when the partname isn't the same as the current cell value it will skip that cell before the code corrects the issue creating holes also once i build the range I don't know how to just average the 3rd column within the range.

    Sub aveCount()
    
    Dim rng As Range
    Dim cl As Range
    Dim partName As String
    Dim startAddress As String
    Dim ws As Worksheet
    Dim count As Double
    Dim orders As Double
    Dim i As Integer
    
        Set ws = ActiveWorkbook.Worksheets("Sheet1")
        'lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Application.ScreenUpdating = False
        i = 0
        For Each cl In ws.Range("A89:A433")
            If i = 0 Then
                partName = cl.Value
            End If
            
            If cl.Value = partName Then
                i = i   1
                
                If rng Is Nothing Then
                    startAddress = cl.Address
                    Set rng = ws.Range(cl.Address).Resize(, 4)
                Else
                    Set rng = Union(rng, ws.Range(cl.Address).Resize(, 4))
                End If
            Else
                i = 0
            End If
            count = rng.Rows.count
            ws.Range(startAddress).Offset(0, 4) = Application.WorksheetFunction.Subtotal(1, rng)
            Debug.Print (startAddress)
            Stop
     
        Next cl 'next row essentially
    
    End Sub

CodePudding user response:

If there won't be the same part on two orders... this will give you the average:
enter image description here
enter image description here
enter image description here

CodePudding user response:

Sub aveCount()

Dim rng As Range
Dim cl As Range
Dim partName As String
Dim startAddress As String
Dim ws As Worksheet
Dim count As Double
Dim orders As Double
Dim i As Integer

    Set ws = ActiveWorkbook.Worksheets("Sheet1")
    'lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Application.ScreenUpdating = False
    'initializing the variable
    startAddress = ws.Range("A141").Address
    
    i = 1
    For Each cl In ws.Range(startAddress & ":A433")
        If cl.Value = cl.Offset(1, 0).Value Then
            i = i   1
            Debug.Print (i)
            Debug.Print (cl.Address)
            If rng Is Nothing Then
                Set rng = ws.Range(cl.Address).Resize(, 4)
                orders = cl.Offset(0, 2).Value
            Else
                Set rng = Union(rng, ws.Range(cl.Address).Resize(, 4))
                orders = orders   cl.Offset(0, 2).Value
            End If
            Debug.Print (orders)
        Else
            orders = orders   cl.Offset(0, 2).Value
            Debug.Print (cl.Address)
            Debug.Print (orders)
            ws.Range(startAddress).Offset(0, 3) = i
            ws.Range(startAddress).Offset(0, 4) = orders / i
            startAddress = ws.Range(startAddress).Offset(i, 0).Address
            i = 1
        End If
        
    Next cl 'next row essentially
    
End Sub
  • Related