VBA procedure too large

```html
Sub Results()

'Declaration of worksheets
Dim Data As Worksheet
Dim Results As Worksheet

Set Data = ActiveWorkbook.Worksheets("Data")
Set Results = ActiveWorkbook.Worksheets("Results")

'Declaration of variables for the sheet "Data"
Dim month As Range
Dim Gender As Range
Dim familyStatus As Range
Dim numChildren As Range
Dim age As Range
Dim act1 As Range
Dim act2 As Range
Dim res1 As Range
Dim res2 As Range
Dim housing As Range
Dim dec1 As Range
Dim dec2 As Range

'Count the number of non-empty rows
Dim i As Integer
Dim num As Range
i = 1
Do
Set num = Data.Range("A" & i)
i = i + 1
Loop While num.Value <> ""
i = i - 2

'Using the month
Dim j As Integer
Dim m As Integer

'Gender
Dim female As Range
Dim male As Range

'Family situation
Dim single As Range
Dim coupleAlone As Range
Dim personWithChildren As Range
Dim coupleWithChildren As Range

'Age
Dim under25 As Range
Dim between2534 As Range
Dim between3544 As Range
Dim between4554 As Range
Dim between5564 As Range
Dim over65 As Range

'Activity
Dim employee As Range
Dim jobSeeker As Range
Dim sickLeave As Range
Dim disability As Range
Dim retiree As Range
Dim other As Range

'Resources
Dim salary As Range
Dim unemploymentBenefits As Range
Dim RSA As Range
Dim Alimony As Range
Dim IJ As Range
Dim CAF As Range
Dim PIAAH As Range
Dim MVA As Range
Dim pension As Range
Dim without As Range
Dim waiting As Range

'Housing
Dim publicHousing As Range
Dim privateHousing As Range
Dim hosted As Range
Dim logccas As Range
Dim otherHousing As Range

'Decisions
Dim st As Range 'Third Party Aid
Dim se As Range 'Cash Aid
Dim scb As Range 'Bank Account Aid
Dim ts As Range 'Service Tickets
Dim edf As Range
Dim gas As Range
Dim avq As Range
Dim mutual As Range
Dim hostel As Range

'Program to complete the table
For j = 1 To i

Set month = Data.Range("B" & j)
Set Gender = Data.Range("C" & j)
Set familyStatus = Data.Range("E" & j)
Set numChildren = Data.Range("F" & j)
Set age = Data.Range("D" & j)
Set act1 = Data.Range("G" & j)
Set act2 = Data.Range("H" & j)
Set res1 = Data.Range("I" & j)
Set res2 = Data.Range("J" & j)
Set housing = Data.Range("K" & j)
Set dec1 = Data.Range("L" & j)
Set dec2 = Data.Range("M" & j)

'January
If month.Value = "January" Then
m = 3

'Gender
Set female = Results.Range("C" & m)
Set male = Results.Range("B" & m)
If Gender.Value = "F" Then
female.Value = female.Value + 1
Else
If Gender.Value = "M" Then
male.Value = male.Value + 1
End If
End If

'Family situation
Set single = Results.Range("E" & m)
Set coupleAlone = Results.Range("F" & m)
Set personWithChildren = Results.Range("G" & m)
Set coupleWithChildren = Results.Range("H" & m)
If numChildren.Value = 0 Then
If familyStatus.Value = "Alone" Then
single.Value = single.Value + 1
Else
If familyStatus.Value = "Couple" Then
coupleAlone.Value = coupleAlone.Value + 1
End If
End If
Else
If numChildren.Value > 0 Then
If familyStatus.Value = "Alone" Then
personWithChildren.Value = personWithChildren.Value + 1
Else
If familyStatus.Value = "Couple" Then
coupleWithChildren.Value = coupleWithChildren.Value + 1
End If
End If
End If
End If

'Age
Set under25 = Results.Range("I" & m)
Set between2534 = Results.Range("J" & m)
Set between3544 = Results.Range("K" & m)
Set between4554 = Results.Range("L" & m)
Set between5564 = Results.Range("M" & m)
Set over65 = Results.Range("N" & m)
If age.Value = "<25" Then
under25.Value = under25.Value + 1
Else
If age.Value = "25/34" Then
between2534.Value = between2534.Value + 1
Else
If age.Value = "35/44" Then
between3544.Value = between3544.Value + 1
Else
If age.Value = "45/54" Then
between4554.Value = between4554.Value + 1
Else
If age.Value = "55/64" Then
between5564.Value = between5564.Value + 1
Else
If age.Value = ">65" Then
over65.Value = over65.Value + 1
End If
End If
End If
End If
End If
End If
'
'Activity
Set employee = Results.Range("O" & m)
Set jobSeeker = Results.Range("P" & m)
Set sickLeave = Results.Range("Q" & m)
Set disability = Results.Range("R" & m)
Set retiree = Results.Range("S" & m)
Set other = Results.Range("T" & m)
If act1.Value = "Employed" Then
employee.Value = employee.Value + 1
Else
If act1.Value = "Job seeker" Then
jobSeeker.Value = jobSeeker.Value + 1
Else
If act1.Value = "Sick leave" Then
sickLeave.Value = sickLeave.Value + 1
Else
If act1.Value = "Disability" Then
disability.Value = disability.Value + 1
Else
If act1.Value = "Retired" Then
retiree.Value = retiree.Value + 1
Else
other.Value = other.Value + 1
End If
End If
End If
End If
End If
If act2.Value <> "" Then
If act2.Value = "Employed" Then
employee.Value = employee.Value + 1
Else
If act2.Value = "Job seeker" Then
jobSeeker.Value = jobSeeker.Value + 1
Else
If act2.Value = "Sick leave" Then
sickLeave.Value = sickLeave.Value + 1
Else
If act2.Value = "Disability" Then
disability.Value = disability.Value + 1
Else
If act2.Value = "Retired" Then
retiree.Value = retiree.Value + 1
Else
other.Value = other.Value + 1
End If
End If
End If
End If
End If
End If

'Resources
Set salary = Results.Range("U" & m)
Set unemploymentBenefits = Results.Range("V" & m)
Set RSA = Results.Range("W" & m)
Set Alimony = Results.Range("X" & m)
Set IJ = Results.Range("Y" & m)
Set CAF = Results.Range("Z" & m)
Set PIAAH = Results.Range("AA" & m)
Set MVA = Results.Range("AB" & m)
Set pension = Results.Range("AC" & m)
Set without = Results.Range("AD" & m)
Set waiting = Results.Range("AE" & m)
If res1.Value = "Salary" Then
salary.Value = salary.Value + 1
Else
If res1.Value = "ASSEDIC" Then
unemploymentBenefits.Value = unemploymentBenefits.Value + 1
Else
If res1.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If res1.Value = "Alimony" Then
Alimony.Value = Alimony.Value + 1
Else
If res1.Value = "Daily Indemnities" Then
IJ.Value = IJ.Value + 1
Else
If res1.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If res1.Value = "Disability Pension" Or res1.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If res1.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If res1.Value = "Retirement" Then
pension.Value = pension.Value + 1
Else
If res1.Value = "Without" Then
without.Value = without.Value + 1
Else
If res1.Value = "Pending" Then
waiting.Value = waiting.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If res2.Value = "Salary" Then
salary.Value = salary.Value + 1
Else
If res2.Value = "ASSEDIC" Then
unemploymentBenefits.Value = unemploymentBenefits.Value + 1
Else
If res2.Value = "RSA" Then
RSA.Value = RSA.Value + 1
Else
If res2.Value = "Alimony" Then
Alimony.Value = Alimony.Value + 1
Else
If res2.Value = "Daily Indemnities" Then
IJ.Value = IJ.Value + 1
Else
If res2.Value = "CAF" Then
CAF.Value = CAF.Value + 1
Else
If res2.Value = "Disability Pension" Or res2.Value = "AAH" Then
PIAAH.Value = PIAAH.Value + 1
Else
If res2.Value = "MVA" Then
MVA.Value = MVA.Value + 1
Else
If res2.Value = "Retirement" Then
pension.Value = pension.Value + 1
Else
If res2.Value = "Without" Then
without.Value = without.Value + 1
Else
If res2.Value = "Pending" Then
waiting.Value = waiting.Value + 1
End If
End If
End If
End If
End If
End If
End If
End If
End If
```

Because there is a table that has already been created to hold the calculated values and the procedure allows for placing the figures directly in the intended locations.

So what can I do?

For:
Maybe then by using:
Application.WorksheetFunction.CountIf(Range(range), data)
Look, this procedure should count the number of women and men for you:
Instead of:

Dim Data As Worksheet Dim Results As Worksheet Set Data = ActiveWorkbook.Worksheets("Data") Set Results = ActiveWorkbook.Worksheets("Results") Dim Gender As Range Dim female As Range Dim male As Range If month.Value = "January" Then m = 3 'Gender Set Gender = Data.Range("C" & j) Set female = Results.Range("C" & m) Set male = Results.Range("B" & m) If Gender.Value = "F" Then female.Value = female.Value + 1 Else If Gender.Value = "M" Then male.Value = male.Value + 1 End If End If

You put:

Sub CountWomenMen() 'Variable declaration Dim m As Integer Dim LastRow As Long 'we determine the last row of column A and store its number in the variable LastRow LastRow = Sheets("Data").Range("A65536").End(xlUp).Row If month.Value = "January" Then m = 3 'In the sheet "Results" With Sheets("Results") 'Cell C3 (3 is based on the variable month m) is equal to the number of ' cells in the Data sheet, column C that contain "F" .Range("C" & m) = Application.WorksheetFunction.CountIf(Sheets("Data").Range("C1:C" & LastRow), "F") .Range("B" & m) = Application.WorksheetFunction.CountIf(Sheets("Data").Range("C1:C" & LastRow), "H") End With End Sub

Test this and get back to us.
--
Best regards,
Franck P

Hello
1. Given the code, there must be a way to shorten it; in particular, all these nested "if then else" statements could be advantageously replaced by more economical and significantly more readable "select case" statements.
2. You can also break the Resultats procedure into several sub-procedures.
3. I believe that in any case, if you want more comprehensive help, you will need to send the file (without confidential data, but with some data) to cijoint.fr in Excel 2003 format so that we can apply it.
Good luck!