VBA Userform using Danish CPR Numbers

[Andekongen]

Hi

I need somesupport to run simple calculation in a VBA user form, based on a Danish CPR-number.

In Demarkeach person has a unique CPR number with 10 digits.

The number couldlook like: 010270-1223

010270 isthe date of birth: 01 is the day, 02 is the month, 70 is the year meaning 1970
Is digit 7:0,1,2,3 is the person borne in 19xx
Is digit 7:4 or 9 is the person born in 19xx if the last 2 digits in the 6 digit is >36 are they < = is the person born in 20xx.
Is digit 7:5,6,7 or 8 and the last 2 digits in the 6 digit is = 36 are the person born in2000

I wouldlike to run the two below formulas based on the input in textbox 1:
Example:

Input Textbox1= 231117-5704
Problem 1: I would likeTtextbox2 to perform thecalculating with the result: 23-11-2017

“=TEXT(LEFT($A2;6);"00-00-00")+0” (Extractof date of birth and year without he 4 last digit)

Problem 2: I would likeTtextbox3 to perform thecalculating with the result:23-10-2020
“DATE(YEAR(C2)+3;MONTH(C2)-1;DAY(C2))” (Date of birth+ 2y and 11 months.

I hope someof you can support me with some magic.

[SamT]

Since I can't tell which MS Application you are using, I moved this thread to the Excel Help Forum

Needs Work, Put "231117-5704 " in Cell C2

Option Explicit

Sub t()
Dim C2 As Range
Set C2 = Range("C2")
Dim D, M, Y, X
D = Left(C2, 2) & "/"
M = MonthName(Mid(C2, 3, 2), True) & "/"
Y = Mid(C2, 5, 2)

X = Format(DateAdd("m", 35, M & D & Y), "d,mmm,yyyy")
End Sub

[Paul_Hossler]

This logic seems to work (used Excel to test)

You'll need to integrate into your own application / user forms

Option Explicit

'DDMMYY-abcd
'a = 0,1,2,3    then born in 19YY
'a = 4,9        if YY < 36 then born in 20YY, if YY > 36 born in 19YY
'a = 5,6,7      if YY = 36 then born in 2000

Sub CPRtest()
    Dim s As String
    Dim DD As Long, MM As Long, YY As Long, A As Long

'textbox1
    s = "231117-5704"
    DD = Mid(s, 1, 2)
    MM = Mid(s, 3, 2)
    YY = Mid(s, 5, 2)
    
    A = Mid(s, 8, 1)
    Select Case A
        Case 0, 1, 2, 3
            YY = 1900 + YY
        Case 4, 9
            If YY > 36 Then
                YY = 1900 + YY
            Else
                YY = 2000 + YY
            End If
        Case 5, 6, 7
            If YY = 36 Then
                YY = 2000
            Else
                YY = 2000 + YY  '   ?????????????
            End If
    End Select


'textbox2
    MsgBox DateSerial(YY, MM, DD)


'textbox3
    MsgBox DateSerial(YY + 2, MM + 11, DD)
End Sub

[Andekongen]

Hi Guys

Many Thanks, it works perfect.

/AK