How to reduce a repetitive macro (loop maybe?)

Blanchetdb · Sep 28, 2023

Hi

So, I have a macro that is repetitive with the only change is the name being searched. The macro works but I am limited on the number of names because I get an error message saying it is too large. Can someone help on condensing this maybe in a loop (not sure how to do that)

VBA Code:

Private Sub CommandButton1_Click()
Range("F15") = Range("D5")

If Range("D5") <> "" Then
Range("P17:P2000").AutoFilter Field:=1, Criteria1:=Range("D5").Value
End If
 
'All / TOUS
If Range("D5") = "" And Range("AB9") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("AD18:AD2000"), "0")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("AD18:AD2000"), "0")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("AD18:AD2000"), "0")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "0")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("AD18:AD2000"), "0")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("AD18:AD2000"), "0")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("AD18:AD2000"), "0")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("AD18:AD2000"), "0")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("AD18:AD2000"), "0")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("AD18:AD2000"), "0")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("AD18:AD2000"), "0")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("AD18:AD2000"), "0")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("AD18:AD2000"), "0")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "0")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("AD18:AD2000"), "0")
End If
If Range("D5") = "" And Range("AB10") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("AD18:AD2000"), "1")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("AD18:AD2000"), "1")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("AD18:AD2000"), "1")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "1")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("AD18:AD2000"), "1")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("AD18:AD2000"), "1")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("AD18:AD2000"), "1")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("AD18:AD2000"), "1")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("AD18:AD2000"), "1")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("AD18:AD2000"), "1")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("AD18:AD2000"), "1")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("AD18:AD2000"), "1")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("AD18:AD2000"), "1")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "1")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("AD18:AD2000"), "1")
End If
If Range("D5") = "" And Range("AB11") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("AD18:AD2000"), "2")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("AD18:AD2000"), "2")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("AD18:AD2000"), "2")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "2")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("AD18:AD2000"), "2")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("AD18:AD2000"), "2")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("AD18:AD2000"), "2")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("AD18:AD2000"), "2")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("AD18:AD2000"), "2")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("AD18:AD2000"), "2")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("AD18:AD2000"), "2")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("AD18:AD2000"), "2")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("AD18:AD2000"), "2")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "2")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("AD18:AD2000"), "2")
End If
If Range("D5") = "" And Range("AB12") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("AD18:AD2000"), "3")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("AD18:AD2000"), "3")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("AD18:AD2000"), "3")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "3")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("AD18:AD2000"), "3")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("AD18:AD2000"), "3")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "3")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "3")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "3")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("AD18:AD2000"), "3")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("AD18:AD2000"), "3")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("AD18:AD2000"), "3")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("AD18:AD2000"), "3")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("AD18:AD2000"), "3")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("AD18:AD2000"), "3")
End If

'Jarek Krukowski
If Range("D5") = "Jarek Krukowski" And Range("AB9") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "0")
End If
If Range("D5") = "Jarek Krukowski" And Range("AB10") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "1")
End If
If Range("D5") = "Jarek Krukowski" And Range("AB11") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "2")
End If
If Range("D5") = "Jarek Krukowski" And Range("AB12") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Jarek Krukowski", Range("AD18:AD2000"), "3")
End If


'Genève Fournier
If Range("D5") = "Genève Fournier" And Range("AB9") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "0")
End If
If Range("D5") = "Genève Fournier" And Range("AB10") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "1")
End If
If Range("D5") = "Genève Fournier" And Range("AB11") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "2")
End If
If Range("D5") = "Genève Fournier" And Range("AB12") = True Then
Range("I9") = WorksheetFunction.CountIfs(Range("X18:X2000"), "In Progress / Encours", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("I10") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed / Finalisé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("I11") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Ongoing / Finalisé - continu", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("I12") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Completed - Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("I13") = WorksheetFunction.CountIfs(Range("X18:X2000"), "Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")

Range("D9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "01 Planning Phase / Phase de planification", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("D10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "02 Poster Open / Affiche ouverte", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("D11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "03 Screening Phase / Phase de dépistage", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("D12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "04 Assessment Phase / Phase d'évaluation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("D13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "05 Process Being Finalized / Processus en cours de finalisation", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("G9") = WorksheetFunction.CountIfs(Range("T18:T2000"), "06 Process completed, Pool Created / Processus complété; bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("G10") = WorksheetFunction.CountIfs(Range("T18:T2000"), "07 Process completed, No Pool Created / Processus complété; sans bassin créé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("G11") = WorksheetFunction.CountIfs(Range("T18:T2000"), "08 Cancelled / Annulé", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("G12") = WorksheetFunction.CountIfs(Range("T18:T2000"), "09 Unproductive / Finalisé - improductif", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
Range("G13") = WorksheetFunction.CountIfs(Range("T18:T2000"), "10 Other - See Comments / Autres - Voir commentaires", Range("P18:P2000"), "Genève Fournier", Range("AD18:AD2000"), "3")
End If

this macro repeats for another 3 names but then I am unable to add additional names

can someone please provide a solution on how to reduce this?

thanks

Blanchetdb · Sep 29, 2023

duggie33 said:
Do you have to do this with VBA?

Doug

it doesn't have to be .... if you have a solution that doesn't use VBA, I am more than willing to explore that option....thanks

kevin9999 · Sep 29, 2023

It would be helpful if you could provide a copy of your sheet using the XL2BB add in, or alternatively share your file via Google Drive, Dropbox or similar file sharing platform. Having said that, please try the following when you get the chance on a copy of your workbook (change the sheet name in the code to match your actual sheet name). I won't be able to get back to you tonight, but I will get back to you when I can.

VBA Code:

Option Explicit
Sub CommandButton1_Click()
    Dim ws As Worksheet, s As String
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    s = ws.Range("D5")
    ws.Range("F15") = s
   
    Dim j As Long, k As Long, m As Long, n As Long
    Dim p, t, x, ab, ad, nums, cats
    nums = Array("01 ", "02 ", "03 ", "04 ", "05 ", "06 ", "07 ", "08 ", "09 ", "10 ")
    cats = Array("*Encours*", "*Completed /*", "*continu*", "*Unproductive*", "*Annulé*")
    p = ws.Range("P18:P2000")
    t = ws.Range("T18:T2000")
    x = ws.Range("X18:X2000")
    ab = ws.Range("AB9:AB12")
    ad = ws.Range("AD18:AD2000")
    n = Application.Match(True, ab, 0) - 1
    ReDim results(1 To 5, 1 To 1)
   
    If s = "" Then
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j - 1) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j - 1) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j + 4) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
    Else
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j + 4) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j + 4) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
            If t(k, 1) Like nums(j + 4) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
                Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
    End If
End Sub

duggie33 · Sep 29, 2023

You could try this with worksheet formulas rather than VBA. You will have to update ranges to match your data and write similar formulas for the other COUNTIFS.

Book1

D

E

F

G

H

I

J

K

L

M

N

O

P

Q

R

S

T

U

V

W

X

Y

Z

AA

AB

AC

AD

1

3

2

3

4

5

Jarek

6

7

8

9

0

01 Planning Phase / Phase de planification

FALSE

10

1

02 Poster Open / Affiche ouverte

FALSE

11

0

03 Screening Phase / Phase de dépistage

FALSE

12

1

04 Assessment Phase / Phase d'évaluation

TRUE

13

0

05 Process Being Finalized / Processus en cours de finalisation

14

1

06 Process completed, Pool Created / Processus complété; bassin créé

15

1

07 Process completed, No Pool Created / Processus complété; sans bassin créé

16

2

08 Cancelled / Annulé

17

1

09 Unproductive / Finalisé - improductif

18

1

10 Other - See Comments / Autres - Voir commentaires

Bob

10 Other - See Comments / Autres - Voir commentaires

2

19

Bob

08 Cancelled / Annulé

3

20

Mike

07 Process completed, No Pool Created / Processus complété; sans bassin créé

2

21

Jarek

03 Screening Phase / Phase de dépistage

2

22

Jarek

07 Process completed, No Pool Created / Processus complété; sans bassin créé

3

23

Jarek

09 Unproductive / Finalisé - improductif

3

24

Mike

08 Cancelled / Annulé

3

25

Bob

06 Process completed, Pool Created / Processus complété; bassin créé

3

26

Genève

04 Assessment Phase / Phase d'évaluation

2

27

Genève

08 Cancelled / Annulé

2

28

Genève

08 Cancelled / Annulé

2

29

Jarek

01 Planning Phase / Phase de planification

2

30

Genève

05 Process Being Finalized / Processus en cours de finalisation

2

31

Genève

04 Assessment Phase / Phase d'évaluation

3

32

Mike

05 Process Being Finalized / Processus en cours de finalisation

2

33

Mike

07 Process completed, No Pool Created / Processus complété; sans bassin créé

2

34

Bob

10 Other - See Comments / Autres - Voir commentaires

2

35

Jarek

04 Assessment Phase / Phase d'évaluation

3

36

Jarek

08 Cancelled / Annulé

3

37

Bob

01 Planning Phase / Phase de planification

3

38

Bob

07 Process completed, No Pool Created / Processus complété; sans bassin créé

2

39

Mike

08 Cancelled / Annulé

2

40

Mike

07 Process completed, No Pool Created / Processus complété; sans bassin créé

3

41

Genève

06 Process completed, Pool Created / Processus complété; bassin créé

3

42

Bob

09 Unproductive / Finalisé - improductif

2

43

Bob

07 Process completed, No Pool Created / Processus complété; sans bassin créé

3

44

Genève

06 Process completed, Pool Created / Processus complété; bassin créé

2

45

Bob

01 Planning Phase / Phase de planification

3

46

Bob

10 Other - See Comments / Autres - Voir commentaires

3

47

Mike

02 Poster Open / Affiche ouverte

2

48

Mike

05 Process Being Finalized / Processus en cours de finalisation

3

49

Mike

01 Planning Phase / Phase de planification

2

50

Jarek

06 Process completed, Pool Created / Processus complété; bassin créé

3

51

Bob

07 Process completed, No Pool Created / Processus complété; sans bassin créé

2

52

Mike

02 Poster Open / Affiche ouverte

2

53

Bob

08 Cancelled / Annulé

2

54

Jarek

05 Process Being Finalized / Processus en cours de finalisation

2

55

Jarek

02 Poster Open / Affiche ouverte

3

56

Genève

08 Cancelled / Annulé

3

57

Mike

03 Screening Phase / Phase de dépistage

2

58

Bob

05 Process Being Finalized / Processus en cours de finalisation

3

59

Bob

05 Process Being Finalized / Processus en cours de finalisation

2

60

Genève

09 Unproductive / Finalisé - improductif

2

61

Genève

09 Unproductive / Finalisé - improductif

2

62

Mike

09 Unproductive / Finalisé - improductif

3

63

Bob

01 Planning Phase / Phase de planification

3

64

Mike

09 Unproductive / Finalisé - improductif

2

65

Bob

01 Planning Phase / Phase de planification

3

66

Bob

02 Poster Open / Affiche ouverte

3

67

Bob

08 Cancelled / Annulé

2

68

Genève

09 Unproductive / Finalisé - improductif

3

69

Jarek

08 Cancelled / Annulé

3

70

Jarek

10 Other - See Comments / Autres - Voir commentaires

3

71

Genève

07 Process completed, No Pool Created / Processus complété; sans bassin créé

2

72

Bob

04 Assessment Phase / Phase d'évaluation

3

73

Genève

08 Cancelled / Annulé

3

74

Genève

01 Planning Phase / Phase de planification

2

75

Genève

04 Assessment Phase / Phase d'évaluation

3

76

Mike

07 Process completed, No Pool Created / Processus complété; sans bassin créé

3

77

Bob

08 Cancelled / Annulé

3

78

Genève

04 Assessment Phase / Phase d'évaluation

3

Sheet1

Cell Formulas
Range	Formula
AB1	AB1	=IF(AB9,0,IF(AB10,1,IF(AB11,2,3)))
D9:D18	D9	=COUNTIFS($T$18:$T$2000,$E9,$P$18:$P$2000,IF($D$5="","*",$D$5),$AD$18:$AD$2000,$AB$1)

It should handle more names without a problem.

Hope that helps,

Doug

Blanchetdb · Sep 30, 2023

kevin9999 said:

It would be helpful if you could provide a copy of your sheet using the XL2BB add in, or alternatively share your file via Google Drive, Dropbox or similar file sharing platform. Having said that, please try the following when you get the chance on a copy of your workbook (change the sheet name in the code to match your actual sheet name). I won't be able to get back to you tonight, but I will get back to you when I can.

VBA Code:

Option Explicit
Sub CommandButton1_Click()
    Dim ws As Worksheet, s As String
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    s = ws.Range("D5")
    ws.Range("F15") = s
  
    Dim j As Long, k As Long, m As Long, n As Long
    Dim p, t, x, ab, ad, nums, cats
    nums = Array("01 ", "02 ", "03 ", "04 ", "05 ", "06 ", "07 ", "08 ", "09 ", "10 ")
    cats = Array("*Encours*", "*Completed /*", "*continu*", "*Unproductive*", "*Annulé*")
    p = ws.Range("P18:P2000")
    t = ws.Range("T18:T2000")
    x = ws.Range("X18:X2000")
    ab = ws.Range("AB9:AB12")
    ad = ws.Range("AD18:AD2000")
    n = Application.Match(True, ab, 0) - 1
    ReDim results(1 To 5, 1 To 1)
  
    If s = "" Then
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j - 1) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j - 1) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j + 4) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
    Else
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j + 4) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j + 4) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
            If t(k, 1) Like nums(j + 4) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
                Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
    End If
End Sub

Test Site.xlsm

docs.google.com

let me know if this works for you .... I really appreciate your time on this

also, I did try the code but it didn't work

Blanchetdb · Sep 30, 2023

Blanchetdb said:
Test Site.xlsm

docs.google.com

let me know if this works for you .... I really appreciate your time on this

also, I did try the code but it didn't work

this is the error I get:

kevin9999 · Sep 30, 2023

You need to make the shared file available to anyone with the link.
Also, try changing the name of the sub to Sub Test() and see if that works.

johnnyL · Oct 1, 2023

Apologies for my last post that had incorrect code, as I said I was tired, I see now how it was jacked up.

I will wait for some sample code, with before & after results, before I make another try.

kevin9999 · Oct 1, 2023

OK, I've thrown together a test sheet that I believe your data may look like (link attached below). I've amended the code and tested it - it seems to me to give you what you want? Let me know how you go with it.

VBA Code:

Option Explicit
Sub Blanchtdb()
    Dim ws As Worksheet, s As String
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    s = ws.Range("D5")
    ws.Range("F15") = s
    
    Dim j As Long, k As Long, m As Long, n As Long
    Dim p, t, x, ab, ad, nums, cats
    nums = Array("01 ", "02 ", "03 ", "04 ", "05 ", "06 ", "07 ", "08 ", "09 ", "10 ")
    cats = Array("*Encours*", "*Completed /*", "*continu*", "*Unproductive*", "*Annulé*")
    p = ws.Range("P18:P2000")
    t = ws.Range("T18:T2000")
    x = ws.Range("X18:X2000")
    ab = ws.Range("AB9:AB12")
    ad = ws.Range("AD18:AD2000")
    n = Application.Match(True, ab, 0) - 1
    ReDim results(1 To 5, 1 To 1)
    
    If s = "" Then
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j - 1) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j - 1) & "*" And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j + 4) & "*" And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
    Else
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j - 1) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j - 1) & "*" And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
            If t(k, 1) Like nums(j + 4) & "*" And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
                Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
    End If
End Sub

Link to test file
Blanchetdb.xlsm

Blanchetdb · Oct 1, 2023

kevin9999 said:

OK, I've thrown together a test sheet that I believe your data may look like (link attached below). I've amended the code and tested it - it seems to me to give you what you want? Let me know how you go with it.

VBA Code:

Option Explicit
Sub Blanchtdb()
    Dim ws As Worksheet, s As String
    Set ws = Worksheets("Sheet1")       '<-- *** Change to actual sheet name ***
    If ws.AutoFilterMode Then ws.AutoFilter.ShowAllData
    s = ws.Range("D5")
    ws.Range("F15") = s
   
    Dim j As Long, k As Long, m As Long, n As Long
    Dim p, t, x, ab, ad, nums, cats
    nums = Array("01 ", "02 ", "03 ", "04 ", "05 ", "06 ", "07 ", "08 ", "09 ", "10 ")
    cats = Array("*Encours*", "*Completed /*", "*continu*", "*Unproductive*", "*Annulé*")
    p = ws.Range("P18:P2000")
    t = ws.Range("T18:T2000")
    x = ws.Range("X18:X2000")
    ab = ws.Range("AB9:AB12")
    ad = ws.Range("AD18:AD2000")
    n = Application.Match(True, ab, 0) - 1
    ReDim results(1 To 5, 1 To 1)
   
    If s = "" Then
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j - 1) And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j - 1) & "*" And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j + 4) & "*" And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
    Else
        For j = 1 To 5
            For k = 1 To UBound(x, 1)
                If x(k, 1) Like cats(j - 1) And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("I9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
                If t(k, 1) Like nums(j - 1) & "*" And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
            Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("D9").Resize(5, 1).Value = results
        ReDim results(1 To 5, 1 To 1)
        For j = 1 To 5
            For k = 1 To UBound(t, 1)
            If t(k, 1) Like nums(j + 4) & "*" And p(k, 1) = s And ad(k, 1) = n Then m = m + 1
                Next k
            results(j, 1) = m: m = 0
        Next j
        ws.Range("G9").Resize(5, 1).Value = results
    End If
End Sub

Link to test file
Blanchetdb.xlsm

I gave the required access.

Test Site.xlsm

HRAdvisor STEP 1: Select an Advisor ÉTAPE 1: Sélectionner un(e) Conseillier(ère),STEP 2: Select a fiscal year ÉTAPE 2: Sélectionner une année fiscale,STEP 4: Select "SEARCH" ÉTAPE : Sélectionner "SEARCH",STEP 4: Select "RESET" ÉTAPE : Sélectionner "RESET" 36 5 HR Advisor / Conseillier(ère) en R...

docs.google.com

and I tried what you recently sent me, and it gives me the same error message.

duggie33 · Oct 1, 2023

Have you tried putting the COUNTIFS formulas on the worksheet?

Doug

How to reduce a repetitive macro (loop maybe?)

Blanchetdb

Board Regular

Blanchetdb

Board Regular

Excel Facts

kevin9999

Well-known Member

duggie33

Active Member

Blanchetdb

Board Regular

Test Site.xlsm

Blanchetdb

Board Regular

Test Site.xlsm

kevin9999

Well-known Member

johnnyL

Well-known Member

kevin9999

Well-known Member

Blanchetdb

Board Regular

Test Site.xlsm

duggie33

Active Member

Forum statistics

Share this page

How to reduce a repetitive macro (loop maybe?)

Board Regular

Board Regular

Excel Facts

Well-known Member

Active Member

Board Regular

Board Regular

Well-known Member

Well-known Member

Well-known Member

Board Regular

Active Member

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock