PDA

View Full Version : [SOLVED] VBA Userform using Danish CPR Numbers



Andekongen
02-15-2018, 03:23 PM
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
02-16-2018, 08:23 AM
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
02-16-2018, 09:32 AM
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
03-08-2018, 09:27 AM
Hi Guys

Many Thanks, it works perfect.:hi:

/AK