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

Question

A different order for a part is in each row. To get the average number of parts ordered, which is the quantity of each order, I need to count how many of each order there are. I need some formula or vba solutions to automate this because I have a lot of rows.

I need to provide the results in a single line, removing all the individual order lines after I have the number of orders and the average number of parts per order filled in.

I'm searching for guidance on how to go about accomplishing this. I appreciate your thoughts and time.

Although I'm still working on this, I'm not sure if VBA is the only option for getting what I need. I was attempting to construct a range based on the part name matching. One problem is that the code skips a cell when the partname is different from the value currently in that cell before fixing the problem, leaving gaps. Additionally, once I've constructed the range, I'm not sure how to just average the third 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

Answer 1

Try this:

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