4
\$\begingroup\$

I've got a large macro which calculates diverse things for my job. I work in a contact center.

Firstly it writes people and forecast data. With this calculates if there are more/less people than it should (depending on the forecast). After this calculation Uses it to calculate the break time for everyone CalculadoraAux.

Once this is all done, the calculation starts(and is the slow block of the code). First for department and then for department and city(this last depends on the department and the number of people working on each city to distribuite things). It calculates for half hours and then 4 totals, grand total, morning, afternoon and night.

Hope I've explained myself kind of clearly, but I can answer anything you need to help me speed up this code:

Option Explicit
Sub Recalcular(Reforecast As Boolean)
 Dim arrAgentes As Variant, wsTD As Worksheet, Comprueba As Boolean, Col As Integer, ColIAux, ColFAux, Reductores As Single, _
 LastRow As Long, x As Long, i As Long, C As Range, y As Long, B As Byte, ColI, ColF, wsP As Worksheet, _
 wsObj As Worksheet, arrKPI As Variant, arrKPI2 As Variant, A As Long, arrDescansos, _
 DictModoDia As Scripting.Dictionary, arrPronosticos, wsPron As Worksheet, wsDescanso As Worksheet, STRUnion As String
 Dim Contador
 '=========================FROM HERE============================='
 Dim DictPronosticos As Scripting.Dictionary
 Dim DictHojaPronosticos As Scripting.Dictionary
 Dim DictModosDias As Scripting.Dictionary
 Set DictPronosticos = New Scripting.Dictionary
 Set DictModos = New Scripting.Dictionary
 Set DictModoDia = New Scripting.Dictionary
 Set DictHojaPronosticos = New Scripting.Dictionary
 Set DictModosDias = New Scripting.Dictionary
 Set wb = ThisWorkbook
 Set ws = wb.Sheets("Programaciones")
 Set wsP = wb.Sheets("Servicio")
 Set wsObj = wb.Sheets("Objetivos")
 Set wsPron = wb.Sheets("Pronosticos")
 If Reforecast Then Set wsPron = wb.Sheets("PronosticosReforecast")
 With ws
 i = .Cells(.Rows.Count, 1).End(xlUp).Row
 .Range("E5:BD" & i).ClearContents
 End With
 Call CrearTablaAgentes 'PivotTable Creation
 Set wsTD = wb.Sheets("TablaProgramados")
 LastRow = wsTD.Cells(wsTD.Rows.Count, 1).End(xlUp).Row
 arrAgentes = wsTD.Range("A2:BC" & LastRow).Value 'Store PivotTable into array
 'Dictionary
 For i = LBound(arrAgentes) To UBound(arrAgentes)
 If arrAgentes(i, 2) = vbNullString Then
 ElseIf Not arrAgentes(i, 3) = vbNullString Then
 STRUnion = Application.Proper(arrAgentes(i, 3)) & arrAgentes(i, 1) & arrAgentes(i, 2) & "1.Presentes Programados"
 DictModosDias.Add STRUnion, i
 Else
 STRUnion = "ALL" & arrAgentes(i, 1) & Mid(arrAgentes(i, 2), 7, Len(arrAgentes(i, 2))) & "1.Presentes Programados"
 DictModosDias.Add STRUnion, i
 End If
 Next i
 Application.DisplayAlerts = False
 wsTD.Delete
 ColI = Array(5, 21, 37, 5)
 ColF = Array(52, 36, 52, 20)
 ColIAux = Array(13, 109, 205, 13)
 ColFAux = Array(300, 204, 300, 108)
 'Dictionary to know positions on some data
 For Each C In wsP.Range("C35", wsP.Range("C35").End(xlDown))
 If C.Font.Color = 49407 Then
 DictPronosticos.Add C.Value, 1
 End If
 Next C
 'Goal Data
 With wsObj
 LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
 .Rows(LastRow & ":1000").Delete
 arrObjetivos = wsObj.UsedRange.Value
 End With
 'Dictionary to know where the goal positions are
 For i = 2 To UBound(arrObjetivos)
 DictModos.Add arrObjetivos(i, 2), i
 Next i
 'Main data to be calculated
 With ws
 LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
 arrMatriz = .Range("A5:BD" & LastRow).Value
 End With
 'Dictionary to know the position of each group
 Set DictKPIModoDia = New Scripting.Dictionary
 For i = 1 To UBound(arrMatriz)
 DictKPIModoDia.Add arrMatriz(i, 1) & arrMatriz(i, 2) & arrMatriz(i, 3) & arrMatriz(i, 4), i
 Next i
 'Data
 arrPronosticos = wsPron.UsedRange.Value
 'Dictionary to know the position of each group
 For i = 2 To UBound(arrPronosticos)
 DictHojaPronosticos.Add arrPronosticos(i, 1) & arrPronosticos(i, 2) & arrPronosticos(i, 3) & arrPronosticos(i, 4), i
 Next i
 Dim Centro As String, Modo As String, Fecha As Date, KPI As String, Centros, Multiplicador As Single, CentroFuncion As String
 For i = 1 To UBound(arrMatriz, 1)
 'Rellenamos los pronósticos
 Centro = arrMatriz(i, 1)
 Modo = arrMatriz(i, 3)
 Fecha = CDate(arrMatriz(i, 2))
 KPI = arrMatriz(i, 4)
 If DictPronosticos.Exists(KPI) Then
 For A = 5 To 56
 If DictHojaPronosticos.Exists(Centro & Fecha & Modo & KPI) Then
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = arrPronosticos(DictHojaPronosticos(Centro & Fecha & Modo & KPI), A)
 Else
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = vbNullString
 End If
 Next A
 End If
 Next i
 For i = 1 To UBound(arrMatriz, 1)
 Centro = arrMatriz(i, 1)
 Modo = arrMatriz(i, 3)
 Fecha = CDate(arrMatriz(i, 2))
 KPI = arrMatriz(i, 4)
 If KPI = "1.Presentes Programados" Then
 STRUnion = Centro & Fecha & Modo & KPI
 For A = 5 To 56
 On Error Resume Next
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = arrAgentes(DictModosDias(STRUnion), A - 1)
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = 0 Then arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = vbNullString
 On Error GoTo 0
 Next A
 ElseIf KPI = "2.Efectivos" Then
 For A = 5 To 52
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, _
 DictModoDia, Centro)
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = 0 Then arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = vbNullString
 Next A
 For A = 53 To 56
 ReDim Contador(ColI(A - 53) To ColF(A - 53)) As Double
 On Error Resume Next
 For Col = LBound(Contador) To UBound(Contador)
 Contador(Col) = arrMatriz(i, Col)
 Next Col
 On Error GoTo 0
 arrMatriz(i, A) = Application.Sum(Contador) / 2
 If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
 Next A
 ElseIf KPI = "94.Sobre/Infra" Then
 For A = 5 To 56
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, _
 DictModoDia, Centro)
 Next A
 End If
 Next i
 ws.Range("A5:BD" & UBound(arrMatriz) + 4) = arrMatriz
 Debug.Print Timer & "aux"
 Outputs.CalculadoraAux
 Debug.Print Timer & "aux"
 '=========================TO HERE=============================' Fast Enough
 '=========================FROM HERE============================='
 wb.Sheets("Mapa Turnos").AutoFilterMode = False
 Set wsDescanso = wb.Sheets("Calculadora AUX")
 arrDescansos = wsDescanso.UsedRange.Value
 wsDescanso.Visible = xlSheetHidden
 For i = 2 To UBound(arrDescansos)
 If Not DictModoDia.Exists(arrDescansos(i, 1) & arrDescansos(i, 3)) Then
 DictModoDia.Add arrDescansos(i, 1) & arrDescansos(i, 3), i
 Else
 DictModoDia(arrDescansos(i, 1) & arrDescansos(i, 3)) = DictModoDia(arrDescansos(i, 1) & arrDescansos(i, 3)) & ", " & i
 End If
 Next i
 Dim SplitCentros, arrPorcentaje, m As Long, CentroCC As String, DictPorcentajeCentros As Scripting.Dictionary
 Set DictPorcentajeCentros = New Scripting.Dictionary
 Erase Contador
 'Calculate KPIs but the ones already calculated
 For i = 1 To UBound(arrMatriz, 1)
 Centro = arrMatriz(i, 1)
 Modo = arrMatriz(i, 3)
 Fecha = CDate(arrMatriz(i, 2))
 KPI = arrMatriz(i, 4)
 If Centro <> "ALL" And KPI = "1.Presentes Programados" Then 'aquí calculamos directamente las capacidades y el % según centro para llamadas y req
 For A = 5 To 56
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) = 0 And Not A = 56 Then GoTo SiguienteCC
 SplitCentros = Split(wb.Sheets("Servicio").Cells.Find(Modo).Offset(0, 1), "/")
 ReDim arrPorcentaje(0 To UBound(SplitCentros))
 For m = 0 To UBound(SplitCentros) 'Rellenamos Efectivos Finales para poder hacer el cálculo a todos
 CentroCC = SplitCentros(m)
 arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "21.Descansos Finales"), A) = _
 Formulas(Fecha, Modo, "21.Descansos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
 arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "22.Efectivos Finales"), A) = _
 Formulas(Fecha, Modo, "22.Efectivos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
 Next m
 For m = 0 To UBound(SplitCentros)
 On Error Resume Next
 arrPorcentaje(m) = _
 (arrMatriz(DictKPIModoDia(SplitCentros(m) & Fecha & Modo & "22.Efectivos Finales"), A) * 1800) / _
 arrMatriz(DictKPIModoDia(SplitCentros(m) & Fecha & Modo & "6.TMO"), A)
 DictPorcentajeCentros.Add SplitCentros(m), m
 On Error GoTo 0
 Next m
 'Porcentaje a aplicar
 On Error Resume Next
 Multiplicador = 0
 Multiplicador = arrPorcentaje(DictPorcentajeCentros(Centro)) / Application.Sum(arrPorcentaje)
 DictPorcentajeCentros.RemoveAll
 'Call Capacity
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), A) = _
 arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "95.Call Capacity"), A) * Multiplicador
 'Pronóstico
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) = Multiplicador * _
 arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "5.Pronóstico"), A)
 'Call Capacity ajustado
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), A) > _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) Then
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "96.Call Capacity ajustado curva"), A) = _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A)
 Else
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "96.Call Capacity ajustado curva"), A) = _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), A)
 End If
 'Requeridos
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "92.Requeridos"), A) = Multiplicador * _
 arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "92.Requeridos"), A)
 'NDA
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "3.NA"), A) = Multiplicador * _
 (arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "3.NA"), A) * _
 arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "5.Pronóstico"), A)) / arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A)
 'NDS
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "4.SL"), A) = Multiplicador * _
 (arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "4.SL"), A) * _
 arrMatriz(DictKPIModoDia("ALL" & Fecha & Modo & "5.Pronóstico"), A)) / arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A)
 'Descubierto
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) > 0 And _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) = 0 Then _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "93.Descubierto"), A) = "SI"
 'Sobre/Infra
 On Error Resume Next
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "94.Sobre/Infra"), A) = _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) - _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "92.Requeridos"), A)
 'Occupancy
 If A < 53 Then
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = _
 (arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) * _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "6.TMO"), A)) / _
 (arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) * 1800)
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) > 1 Then _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = 1 'si el occupancy es mayor que 1
 ElseIf A = 56 Then
 KPI = "97.Occ"
 GoTo Totales:
 End If
SiguienteCC:
 Next A
 End If
 If KPI = "92.Requeridos" Or KPI = "5.Pronóstico" Or DictPronosticos.Exists(KPI) Then GoTo SiguienteKPI
 If KPI = "1.Presentes Programados" Or KPI = "2.Efectivos" Or Centro = "ALL" And KPI = "94.Sobre/Infra" Then GoTo SiguienteKPI
 If Centro <> "ALL" And Not arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), 53) = 0 Then GoTo SiguienteKPI
 For A = 5 To 52
 arrMatriz(i, A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, DictModoDia, Centro)
 Next A
Totales:
 'Totals
 For A = 53 To 56
 Select Case KPI
 Case "93.Descubierto", "94.Sobre/Infra", "96.Call Capacity ajustado curva"
 arrMatriz(i, A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, DictModoDia, Centro)
 Case "3.NA", "4.SL", "97.Occ"
 ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
 ReDim arrKPI2(ColI(A - 53) To ColF(A - 53))
 For Col = ColI(A - 53) To ColF(A - 53)
 arrKPI2(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), Col)
 arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), Col)
 Next Col
 On Error Resume Next
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Application.SumProduct(arrKPI, arrKPI2) / Application.Sum(arrKPI2)
 On Error GoTo 0
 Erase arrKPI
 Erase arrKPI2
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 0 And arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 1 And Not KPI = "97.Occ" Then arrMatriz(i, A) = 1
 Case "21.Descansos Finales"
 On Error Resume Next
 Reductores = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "7.Formación"), A) + _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "9.Ausencias no programadas"), A) + _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "91.Otros"), A)
 On Error GoTo 0
 Contador = Split(DictModoDia(arrMatriz(i, 2) & arrMatriz(i, 3)), ", ")
 If UBound(Contador) = -1 Then
 arrMatriz(i, A) = 0
 GoTo SiguienteKPI
 End If
 With wsDescanso
 arrMatriz(i, A) = (Application.Sum(.Range(.Cells(Contador(0), ColIAux(A - 53)), _
 .Cells(Contador(UBound(Contador)), ColFAux(A - 53)))) * 60) / _
 (Application.Sum(.Range(.Cells(Contador(0), 7), .Cells(Contador(UBound(Contador)), 8))) * 3600)
 End With
 If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
 Case "1.Presentes Programados", "2.Efectivos", "22.Efectivos Finales"
 ReDim Contador(ColI(A - 53) To ColF(A - 53)) As Double
 On Error Resume Next
 For Col = LBound(Contador) To UBound(Contador)
 Contador(Col) = arrMatriz(i, Col)
 Next Col
 On Error GoTo 0
 arrMatriz(i, A) = Application.Sum(Contador) / 2
 Case Else
 ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
 For Col = ColI(A - 53) To ColF(A - 53)
 arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), Col)
 Next Col
 arrMatriz(i, A) = Application.Sum(arrKPI)
 If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
 Erase arrKPI
 End Select
 Next A
SiguienteKPI:
 Next i
 '=========================TO HERE=============================' Very slow and time consuming.
 'Paste the array back to the worksheet
 With ws
 .Range("A5:BD" & UBound(arrMatriz) + 4) = arrMatriz
 End With
End Sub

External functions such as CalculadoraAux or Formulas don't have effect on the executing time.

PS: there might be variables not declared here, but they are global variables (When I first started this I didn't know that shouldn't happen...)

Edit: Sample This will stay up for 7 days. This file takes about 57s to complete the calculation (is one of the fastest) before some changes it was taking 5-10 seconds which was the optimal time since the users click this button often.

asked May 3, 2019 at 11:23
\$\endgroup\$
4
  • \$\begingroup\$ Are there 2 separate code blocks included? I see From Here and To Here twice. \$\endgroup\$ Commented May 3, 2019 at 12:59
  • 1
    \$\begingroup\$ just to let you know where the process slows down. but its a single procedure. \$\endgroup\$ Commented May 3, 2019 at 13:03
  • 1
    \$\begingroup\$ Do you have any sample data you can provide that will work with your code above? \$\endgroup\$ Commented May 7, 2019 at 16:42
  • \$\begingroup\$ @PeterT I uploaded a sample file the link is on my post. \$\endgroup\$ Commented May 8, 2019 at 11:39

1 Answer 1

1
\$\begingroup\$

Performance could improve by merging these two loops into one (inside the For A = 5 To 56 loop) and taking two of these DictKPIModoDia values to a variable (since they don't change inside the loop):

Dim upperBound as long
upperBound = UBound(SplitCentros)
For m = 0 To upperBound 'Rellenamos Efectivos Finales para poder hacer el cálculo a todos
 CentroCC = SplitCentros(m)
 arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "21.Descansos Finales"), A) = _
 Formulas(Fecha, Modo, "21.Descansos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
 arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "22.Efectivos Finales"), A) = _
 Formulas(Fecha, Modo, "22.Efectivos Finales", A, i, arrDescansos, DictModoDia, CentroCC)
 'end of original first loop
 On Error Resume Next 'here it is better to check that the denominator arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "6.TMO"), A) <> 0 instead of resuming next. If you really need this resume next, place it before the loop.
 arrPorcentaje(m) = _
 (arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "22.Efectivos Finales"), A) * 1800) / arrMatriz(DictKPIModoDia(CentroCC & Fecha & Modo & "6.TMO"), A)
 DictPorcentajeCentros.Add CentroCC, m
 On Error GoTo 0 'You probably don't need this, specially if you check above calculation for zero in the denominator
 'end of original second loop
Next m

The other thing that might improve performance would be if you manage to incorporate this Totales: For A = 53 To 56 loop in your main A loop so that you don't have to loop again. Something like this:

'Occupancy
If A < 53 Then
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = _
 (arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), A) * _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "6.TMO"), A)) / _
 (arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "22.Efectivos Finales"), A) * 1800)
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) > 1 Then _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "97.Occ"), A) = 1 'si el occupancy es mayor que 1
ElseIf A = 56 Then
 KPI = "97.Occ"
 'GoTo Totales: 'Commented out
Else '53 to 56
 'Here, the code to calculate totals from A=53 to 56, ideally a call to a function. Ex:
 CaculateKPI
End If

...

Public Sub CalculateKPI()
 Select Case KPI
 Case "93.Descubierto", "94.Sobre/Infra", "96.Call Capacity ajustado curva"
 arrMatriz(i, A) = Formulas(Fecha, Modo, KPI, A, i, arrDescansos, DictModoDia, Centro)
 Case "3.NA", "4.SL", "97.Occ"
 ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
 ReDim arrKPI2(ColI(A - 53) To ColF(A - 53))
 For Col = ColI(A - 53) To ColF(A - 53)
 arrKPI2(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "5.Pronóstico"), Col)
 arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), Col)
 Next Col
 On Error Resume Next
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) = Application.SumProduct(arrKPI, arrKPI2) / Application.Sum(arrKPI2)
 On Error GoTo 0
 Erase arrKPI
 Erase arrKPI2
 If arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 0 And arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & KPI), A) > 1 And Not KPI = "97.Occ" Then arrMatriz(i, A) = 1
 Case "21.Descansos Finales"
 On Error Resume Next
 Reductores = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "7.Formación"), A) + _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "9.Ausencias no programadas"), A) + _
 arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "91.Otros"), A)
 On Error GoTo 0
 Contador = Split(DictModoDia(arrMatriz(i, 2) & arrMatriz(i, 3)), ", ")
 If UBound(Contador) = -1 Then
 arrMatriz(i, A) = 0
 GoTo SiguienteKPI
 End If
 With wsDescanso
 arrMatriz(i, A) = (Application.Sum(.Range(.Cells(Contador(0), ColIAux(A - 53)), _
 .Cells(Contador(UBound(Contador)), ColFAux(A - 53)))) * 60) / _
 (Application.Sum(.Range(.Cells(Contador(0), 7), .Cells(Contador(UBound(Contador)), 8))) * 3600)
 End With
 If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
 Case "1.Presentes Programados", "2.Efectivos", "22.Efectivos Finales"
 ReDim Contador(ColI(A - 53) To ColF(A - 53)) As Double
 On Error Resume Next
 For Col = LBound(Contador) To UBound(Contador)
 Contador(Col) = arrMatriz(i, Col)
 Next Col
 On Error GoTo 0
 arrMatriz(i, A) = Application.Sum(Contador) / 2
 Case Else
 ReDim arrKPI(ColI(A - 53) To ColF(A - 53))
 For Col = ColI(A - 53) To ColF(A - 53)
 arrKPI(Col) = arrMatriz(DictKPIModoDia(Centro & Fecha & Modo & "95.Call Capacity"), Col)
 Next Col
 arrMatriz(i, A) = Application.Sum(arrKPI)
 If arrMatriz(i, A) = 0 Then arrMatriz(i, A) = vbNullString
 Erase arrKPI
 End Select
End Sub
Justin
2,6093 gold badges21 silver badges59 bronze badges
answered May 7, 2019 at 12:05
\$\endgroup\$
1
  • \$\begingroup\$ I uploaded a sample file, the link is on my post. \$\endgroup\$ Commented May 8, 2019 at 11:40

Your Answer

Draft saved
Draft discarded

Sign up or log in

Sign up using Google
Sign up using Email and Password

Post as a guest

Required, but never shown

Post as a guest

Required, but never shown

By clicking "Post Your Answer", you agree to our terms of service and acknowledge you have read our privacy policy.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.