VBA for AverageIfs formula

[abonnette86]

I have a relatively large inventory spreadsheet where I have a column for calculated usage, and I need to generate average weekly usage based on multiple criteria rolling down the sheet. But the native AverageIfs() formula is so slow, and I need the sheet to work quickly, so VBA seems to be a better option to do the job.

Is there a way to replicate this in VBA and have it automatically run on cell change?

= IFERROR ( ROUNDUP ( AVERAGEIFS ( $J$2 : $J14670 , $A$2 : $A14670 , ">=" & $L14670 , $A$2 : $A14670 , "<=" & $A14670 , $B$2 : $B14670 , $B14670 , $C$2 : $C14670 , $C14670 ) , 0 ) , 0 )

I wouldnt mind referencing the whole column either, I limited the range to try saving calc time. Didnt work

 

[DanteAmor]

Try the following code. The response time depends on the maximum number of joins you have in columns B and C.
For example, if "S. Hatfield - Dry Wipes" is the combination that appears the most times and appeared 30 times. For 20 thousand records, the response time is one second.
Try and tell us.

Sub AverageIfs_formula()
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, cad As String
  Dim i As Long, j As Long, m As Long, n As Long
  Dim nSumar As Double, nCount As Long, nRows As Long, nCols As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2:L" & Range("A" & Rows.Count).End(3).Row).Value2
  
  For i = 1 To UBound(a, 1)
    cad = a(i, 2) & "|" & a(i, 3)
    dic(cad) = dic(cad) + 1
    If dic(cad) > nCols Then nCols = dic(cad)
  Next
  
  nRows = dic.Count
  dic.RemoveAll
  ReDim b(1 To nRows, 1 To nCols * 2)
  ReDim c(1 To UBound(a, 1), 1 To 1)
  
  For i = 1 To UBound(a, 1)
    cad = a(i, 2) & "|" & a(i, 3)
    If Not dic.exists(cad) Then
      m = m + 1
      dic(cad) = m & "|" & 1
      b(m, 1) = a(i, 1)
      b(m, 2) = a(i, 10)
      c(i, 1) = a(i, 10)
    Else
      m = Split(dic(cad), "|")(0)
      n = Split(dic(cad), "|")(1) + 2
      dic(cad) = m & "|" & n
      b(m, n) = a(i, 1)
      b(m, n + 1) = a(i, 10)
      nCount = 0
      nSumar = 0
      For j = 1 To n Step 2
        If b(m, j) >= a(i, 12) And b(m, j) <= a(i, 1) Then
          nCount = nCount + 1
          nSumar = nSumar + b(m, j + 1)
        End If
      Next
      c(i, 1) = WorksheetFunction.Round(nSumar / nCount, 0)
    End If
  Next
  
  Range("M2").Resize(UBound(a, 1)).Value = c
End Sub

 

[DanteAmor]

I missed putting the value 0 when the condition is not met.
Try the following:

Sub AverageIfs_formula()
  Dim a As Variant, b As Variant, c As Variant
  Dim dic As Object, cad As String
  Dim i As Long, j As Long, m As Long, n As Long
  Dim nSumar As Double, nCount As Long, nRows As Long, nCols As Long
  
  Set dic = CreateObject("Scripting.Dictionary")
  a = Range("A2:L" & Range("A" & Rows.Count).End(3).Row).Value2
  
  For i = 1 To UBound(a, 1)
    cad = a(i, 2) & "|" & a(i, 3)
    dic(cad) = dic(cad) + 1
    If dic(cad) > nCols Then nCols = dic(cad)
  Next
  
  nRows = dic.Count
  dic.RemoveAll
  ReDim b(1 To nRows, 1 To nCols * 2)
  ReDim c(1 To UBound(a, 1), 1 To 1)
  
  For i = 1 To UBound(a, 1)
    cad = a(i, 2) & "|" & a(i, 3)
    If Not dic.exists(cad) Then
      m = m + 1
      dic(cad) = m & "|" & 1
      b(m, 1) = a(i, 1)
      b(m, 2) = a(i, 10)
      If b(m, 1) >= a(i, 12) And b(m, 1) <= a(i, 1) Then
        c(i, 1) = a(i, 10)
      Else
        c(i, 1) = 0
      End If
    Else
      m = Split(dic(cad), "|")(0)
      n = Split(dic(cad), "|")(1) + 2
      dic(cad) = m & "|" & n
      b(m, n) = a(i, 1)
      b(m, n + 1) = a(i, 10)
      nCount = 0
      nSumar = 0
      For j = 1 To n Step 2
        If b(m, j) >= a(i, 12) And b(m, j) <= a(i, 1) Then
          nCount = nCount + 1
          nSumar = nSumar + b(m, j + 1)
        End If
      Next
      If nCount > 0 Then
        c(i, 1) = WorksheetFunction.Round(nSumar / nCount, 0)
      Else
        c(i, 1) = 0
      End If
    End If
  Next
  
  Range("M2").Resize(UBound(a, 1)).Value = c
End Sub

 

[DanteAmor]

HI @abonnette86, You had the opportunity to test the macro, let me know any questions.