Private Sub doExtraction() Cells(2, 10).Activate Do While ActiveCell.Offset(0, -9).Text <> "" Dim fiscal fiscal = ActiveCell.Value If Len(fiscal) = 16 Then ActiveCell.Offset(0, 1).Value = ExtractGender(fiscal) ActiveCell.Offset(0, 2).Value = ExtractBirthdate(fiscal) End If ActiveCell.Offset(1, 0).Activate LoopEnd SubPrivate Function ExtractGender(ByVal fiscalcode As String) Dim genderDay genderDay = Mid(fiscalcode, 10, 2) If genderDay > 40 Then ExtractGender = "W" Else ExtractGender = "M" End IfEnd FunctionPrivate Function ExtractBirthdate(ByVal fiscalcode As String) Dim month, months, day, year As String months = "ABCDEHLMPRST" fiscalMonthIdx = Mid(fiscalcode, 9, 1) month = InStr(months, fiscalMonthIdx) day = Mid(fiscalcode, 10, 2) day = day Mod 40 year = Mid(fiscalcode, 7, 2) ExtractBirthdate = day & "." & month & ".19" & yearEnd Function