VBA - Array calculation with Function and Loops

Question

I am writing a program in VBA that is acting as a Workforce Management Tool. In this particular problem I am trying to take a set of numbers (widgets produced and widget errors) and create a total reject rate --> (Widgets ErrorsA / (Widgets ProducedA + Widget ErrorsA). Each row needs to have it's own reject rate pasted at the end of the row.

The data is set up like this: ProductA ErrorA ProductB ErrorB | RejectRate date1 Name1 Team1 4 2 4 0 0.16%

I need to be able to do this calculation through automation. I have very very basic knowledge with Arrays and with help from another post was able to create 1 array before which is in my code. Working off of that however I have been unsuccessful in figuring out how to store these variables in order to do the necessary calculations.

Could somebody help please?

The steps seem to be: Hold the first production number in a variable x, hold the second production number in a variable y and run the equation (y/(x+y). Hold the answer in an array. Then step 2 over to the next pair and repeat. At the end, average all the numbers that are stored in the array and paste it at the end of the row.

Do this for each row.

We also need to keep in mind that mathematically we cannot divide by zero, and in these numbers there will be zeros in the production variable to contend with (the rejects being zero should not be an issue).

Here is my code. I have made a note to the area that I am stuck on. Thanks!

Sub InsertColumnsAndFormulasUntilEndOfProductivityTable_MakeProductivityNumbers()

With Sheet6
    Set EmployeesRange = .Range("A1", .Range("B1").End(xlDown))
End With

With Sheet1
    Set ActivityRange = .Range("A1", .Range("B1").End(xlDown))
End With

'insert column (For i = 1...) and then vlookup (FormulaRange1.Formula...)
With Sheet4
    y = .Cells(.Rows.Count, 1).End(xlUp).Row
    Dim j As Long
    x = (.Cells(1, .Columns.Count).End(xlToLeft).Column) * 2
    Startrow = 2
    StartColumn = 2
    j = ActiveCell.Row


    For i = 1 + StartColumn To (x + 1) Step 2
        .Columns(i).EntireColumn.Insert
        Set FormulaRange1 = .Range(.Cells(Startrow, i), .Cells(y, i))

           If i = 3 Then
                'insert title for usernames and then vlookup
                Cells(Startrow - 1, i).Value = Cells(Startrow - 1, i - 1).Value & "'s Team"
                FormulaRange1.FormulaR1C1 = "=VLookup(R[0]C[-1],'" & EmployeesRange.Parent.Name & "'!" & EmployeesRange.Address(1, 1, xlR1C1) & ", 2, False)"

            ElseIf i <= x Then
                'insert title for activities and then vlookup lock row 1
                Cells(Startrow - 1, i).Value = Cells(Startrow - 1, i - 1).Value & " Cycle Time"
                FormulaRange1.FormulaR1C1 = "=VLookup(R1C[-1],'" & ActivityRange.Parent.Name & "'!" & ActivityRange.Address(1, 1, xlR1C1) & ", 2, False)"
            Else
                'Sum totals of productivity per person per day
                Cells(Startrow - 1, i - 1).Value = "Totals"
                For j = 2 To y
                Set dataRange2 = .Range(.Cells(j, StartColumn + 2), .Cells(j, i))
                Cells(j, i - 1).Value = CalcProductivity(dataRange2)
                Next

           End If
    Next
    'THIS IS WHERE PROBLEMS START
                i = x + 1
                Cells(Startrow - 1, i).Value = "Reject Rates"
                For j = 2 To y
                Set dataRange2 = .Range(.Cells(j, StartColumn + 2), .Cells(j, i))
                Cells(j, i + 1).Value = RejectRates(dataRange2)
                Next






End With
End Sub

Public Function RejectRates(dataRange As Range) As Double

    Dim dataArray As Variant
    Dim i As Long, t As Long
    Dim runningSum2 As Double


    dataArray = dataRange

    runningSum = 0#

    For i = 1 To UBound(dataArray, 2) Step 4
        runningSum2 = runningSum2 + (dataArray(1, i + 3) / (dataArray(1, i + 1) + dataArray(1, i + 3)))
    Next
    RejectRates = runningSum2

End Function


Public Function CalcProductivity(dataRange As Range) As Double
    '--- input range is 'n' pairs of activity,cycle data.
    '    productivity is calculated by the sum of all activity * cycle pairs
    Dim dataArray As Variant
    Dim i As Long, t As Long
    Dim runningSum As Double


    dataArray = dataRange     'copy to memory array for speed

    runningSum = 0#

    For i = 1 To UBound(dataArray, 2) Step 2
        runningSum = runningSum + (dataArray(1, i) * dataArray(1, i + 1))
    Next
    CalcProductivity = runningSum

End Function

Answer 1

I'm not entirely sure I understand what you're doing, but I think you want a running average reject rate going down the rows?

If this is right, then you could use a formula to do this

Assuming Product A count in col A, errorA in col B, Product B in col C, Error B in col D Running Average reject rate for prod A in col E would be

=SUM($B$2:B2)/(SUM($A$2:$B2))

and then simply copy this formula down.

Note here, that I've locked the first cells, but as you copy down, the range will get larger, so you end up with a running average.

Sadly, though, I'm still guessing that this is what you're looking for...