title: VBA - Array calculation with Function and Loops
body: <p><a href="https://i.stack.imgur.com/kHUQX.png" rel="nofollow noreferrer"><img src="https://i.stack.imgur.com/kHUQX.png" alt="enter image description here"></a>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.</p>
  
  <p>The data is set up like this:
                     ProductA  ErrorA  ProductB  ErrorB |  RejectRate
  date1  Name1 Team1     4        2      4         0         0.16%</p>
  
  <p>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.</p>
  
  <p>Could somebody help please?</p>
  
  <p>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.</p>
  
  <p>Do this for each row.</p>
  
  <p>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).</p>
  
  <p>Here is my code. I have made a note to the area that I am stuck on. Thanks!</p>
  
  <pre><code>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 &amp; "'s Team"
                  FormulaRange1.FormulaR1C1 = "=VLookup(R[0]C[-1],'" &amp; EmployeesRange.Parent.Name &amp; "'!" &amp; EmployeesRange.Address(1, 1, xlR1C1) &amp; ", 2, False)"
  
              ElseIf i &lt;= x Then
                  'insert title for activities and then vlookup lock row 1
                  Cells(Startrow - 1, i).Value = Cells(Startrow - 1, i - 1).Value &amp; " Cycle Time"
                  FormulaRange1.FormulaR1C1 = "=VLookup(R1C[-1],'" &amp; ActivityRange.Parent.Name &amp; "'!" &amp; ActivityRange.Address(1, 1, xlR1C1) &amp; ", 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
  </code></pre>