' *************************************************************************
' *        ID Card Check Digit Calculation - By Mr P.T. TSUI              *
' *************************************************************************
' * ID Card No = Prefix(2-digits) + Numbers(6-Digits) + Check Digit       *
' *    Total   = P1x9 + P2x8 + N1x7 + N2x6 + N3x5 + N4x4 + N5x3 + N6x2    *
' *  Remainder = Total / 11 ...... Remainder                              *
' *     CD     =  11 - Remainder  If CD=10 then CD=A                      *
' *************************************************************************
' *   Code     * 0 - 9 * 10 - 35 *  36   * IC No: P1 P2 N1 N2 N3 N4 N5 N6 *
' *   Char     * 0 - 9 * A  -  Z * Space *        x9 x8 x7 x6 x5 x4 x3 x2 *
' * ASCII Code * 48-57 * 65 - 90 *  32   *                                *
' *************************************************************************
'
Sub CheckDigit()
'
Dim DigNum(10)
Dim DigNumb$(10)
Dim Total(10)
'
Begin:
   Msg1 = " ¿é¤J¨­¥÷ÃÒ¸¹½X Enter ID Card Number"
   Msg2 = "    ¤G¼Æ¦ì­^¤å¦r   Prefix (2-Digits) +" + Chr$(13) + "    ¤»¼Æ¦ì¼Æ¥Ø¦r   Numbers (6-Digits)"
   Msg3 = "        ¨Ò¦p    e.g.          XE123456"
   Title1 = "    ¨­¥÷ÃÒ¸¹½XÀˬd½Xªº­pºâ Check Digit of ID Card Number"
   ID_Card$ = InputBox(Chr$(13) + Msg1 + Chr$(13) + Msg2 + Chr$(13) + Msg3, Title1)
'
'Prefix
       If Len(ID_Card$) > 8 Or Len(ID_Card$) < 7 Then GoTo Begin
       If Len(ID_Card$) = 8 Then Prefix1$ = Mid$(ID_Card$, 1, 1)
       If Len(ID_Card$) = 8 Then Prefix2$ = Mid$(ID_Card$, 2, 1)
       If Len(ID_Card$) = 8 Then Number$ = Mid$(ID_Card$, 3, 6)
       If Len(ID_Card$) = 7 Then Prefix1$ = " "
       If Len(ID_Card$) = 7 Then Prefix2$ = Mid$(ID_Card$, 1, 1)
       If Len(ID_Card$) = 7 Then Number$ = Mid$(ID_Card$, 2, 6)
'
'Prefix1
       If Prefix1$ = " " Then P1 = 36
       If Prefix1$ = " " Then Total_P1 = P1 * 9
       If Prefix1$ = " " Then GoTo Prefix2
       If Asc(Prefix1$) >= 97 And Asc(Prefix1$) <= 122 Then Prefix1$ = UCase(Prefix1$)
       If Asc(Prefix1$) >= 65 And Asc(Prefix1$) <= 90 Then P1 = Asc(Prefix1$) - 55 Else GoTo Begin
       Total_P1 = P1 * 9
'
Prefix2:
       If Asc(Prefix2$) >= 97 And Asc(Prefix2$) <= 122 Then Prefix2$ = UCase(Prefix2$)
       If Asc(Prefix2$) >= 65 And Asc(Prefix2$) <= 90 Then P2 = Asc(Prefix2$) - 55 Else GoTo Begin
       Total_P2 = P2 * 8
'
'Numbers
       TotalSum = 0
       For N = 1 To 6
           DigNumb$(N) = Mid$(Number$, N, 1)
           If Asc(DigNumb$(N)) < 48 Or Asc(DigNumb$(N)) > 57 Then GoTo Begin
           DigNum(N) = Val(DigNumb$(N))
           Total(N) = DigNum(N) * (8 - N)
           TotalSum = TotalSum + Total(N)
       Next N
'
'CheckDigit
       Remainder = (TotalSum + Total_P1 + Total_P2) Mod 11
       Check_Digit = (11 - Remainder) Mod 11
       If Check_Digit = 10 Then Ck_Digit$ = "A" Else Ck_Digit$ = Str$(Check_Digit)
'
'Display ID Card No - Check Digit
   Msg4 = "¨­¥÷ÃÒ¸¹½X ID Card No.: " + Prefix1$ + Prefix2$ + Number$ + " - " + Ck_Digit$
   Title2 = "   Ä~Äò¨­¥÷ÃÒ¸¹½X ID Card No. - To continue ?"
   Response = MsgBox(Msg4, 4, Title2)
   If Response = vbYes Then GoTo Begin
'
End Sub

If Mid(inHKID, 2, 1) >= "A" And Mid(inHKID, 2, 1) <= "Z" Then
  hkid_x1 = Mid(inHKID, 1, 1)
  hkid_x2 = Mid(inHKID, 2, 1)
  hkid_digit1 = Mid(inHKID, 3, 1)
  hkid_digit2 = Mid(inHKID, 4, 1)
  hkid_digit3 = Mid(inHKID, 5, 1)
  hkid_digit4 = Mid(inHKID, 6, 1)
  hkid_digit5 = Mid(inHKID, 7, 1)
  hkid_digit6 = Mid(inHKID, 8, 1)
  If Mid(inHKID, 9, 1) = "(" Then
    hkid_check_digit = Mid(inHKID, 10, 1)
  Else
    hkid_check_digit = Mid(inHKID, 9, 1)
  End If
Else
  hkid_x1 = " "
  hkid_x2 = Mid(inHKID, 1, 1)
  hkid_digit1 = Mid(inHKID, 2, 1)
  hkid_digit2 = Mid(inHKID, 3, 1)
  hkid_digit3 = Mid(inHKID, 4, 1)
  hkid_digit4 = Mid(inHKID, 5, 1)
  hkid_digit5 = Mid(inHKID, 6, 1)
  hkid_digit6 = Mid(inHKID, 7, 1)
  If Mid(inHKID, 9, 1) = "(" Then
    hkid_check_digit = Mid(inHKID, 9, 1)
  Else
    hkid_check_digit = Mid(inHKID, 8, 1)
  End If
End If

Select Case hkid_x1
Case "A"
  hkid_x1_num = 10
Case "B"
  hkid_x1_num = 11
Case "C"
  hkid_x1_num = 12
Case "D"
  hkid_x1_num = 13
Case "E"
  hkid_x1_num = 14
Case "F"
  hkid_x1_num = 15
Case "G"
  hkid_x1_num = 16
Case "H"
  hkid_x1_num = 17
Case "I"
  hkid_x1_num = 18
Case "J"
  hkid_x1_num = 19
Case "K"
  hkid_x1_num = 20
Case "L"
  hkid_x1_num = 21
Case "M"
  hkid_x1_num = 22
Case "N"
  hkid_x1_num = 23
Case "O"
  hkid_x1_num = 24
Case "P"
  hkid_x1_num = 25
Case "Q"
  hkid_x1_num = 26
Case "R"
  hkid_x1_num = 27
Case "S"
  hkid_x1_num = 28
Case "T"
  hkid_x1_num = 29
Case "U"
  hkid_x1_num = 30
Case "V"
  hkid_x1_num = 31
Case "W"
  hkid_x1_num = 32
Case "X"
  hkid_x1_num = 33
Case "Y"
  hkid_x1_num = 34
Case "Z"
  hkid_x1_num = 35
Case " "
  hkid_x1_num = 36
End Select
Select Case hkid_x2
Case "A"
  hkid_x2_num = 10
Case "B"
  hkid_x2_num = 11
Case "C"
  hkid_x2_num = 12
Case "D"
  hkid_x2_num = 13
Case "E"
  hkid_x2_num = 14
Case "F"
  hkid_x2_num = 15
Case "G"
  hkid_x2_num = 16
Case "H"
  hkid_x2_num = 17
Case "I"
  hkid_x2_num = 18
Case "J"
  hkid_x2_num = 19
Case "K"
  hkid_x2_num = 20
Case "L"
  hkid_x2_num = 21
Case "M"
  hkid_x2_num = 22
Case "N"
  hkid_x2_num = 23
Case "O"
  hkid_x2_num = 24
Case "P"
  hkid_x2_num = 25
Case "Q"
  hkid_x2_num = 26
Case "R"
  hkid_x2_num = 27
Case "S"
  hkid_x2_num = 28
Case "T"
  hkid_x2_num = 29
Case "U"
  hkid_x2_num = 30
Case "V"
  hkid_x2_num = 31
Case "W"
  hkid_x2_num = 32
Case "X"
  hkid_x2_num = 33
Case "Y"
  hkid_x2_num = 34
Case "Z"
  hkid_x2_num = 35
Case " "
  hkid_x2_num = 36
End Select

hkid_sum = hkid_x1_num * 9 + _
          hkid_x2_num * 8 + _
          hkid_digit1 * 7 + _
          hkid_digit2 * 6 + _
          hkid_digit3 * 5 + _
          hkid_digit4 * 4 + _
          hkid_digit5 * 3 + _
          hkid_digit6 * 2
         
hkid_mod = hkid_sum Mod 11
HKID_CheckDigit = CStr(11 - hkid_mod)
If HKID_CheckDigit = 10 Then HKID_CheckDigit = "A"
If HKID_CheckDigit = 11 Then HKID_CheckDigit = "0"

End Function

¦p¦ó±Nµ{¦¡½X¥N¤Juserform¤º,¥Îtextbox¿é¤J¸ê®Æ«á,·í¬O¿ù»~ªºhkid®É·|¥X²{msgbox°T®§.

µù:»¡©ú¬°ºK¿ý¦Ûºô¸ô¬Y³B(¤w¤£¸Ô)¹ï¤£°_­ìµÛ§@ªÌ¤F

®Ö¹ïcolumn A ªº¨­¥÷ÃÒ¸¹½X:
1.Highlight whole column A
2.¸ê®Æ>ÅçÃÒ
3.³]©w
Àx¦s®æ¤º¤¹³\: ¦Û­q
¤½¦¡: =(CODE(IF(LEN(A2)=8,"[",LEFT(RIGHT(UPPER(A2),9))))-55)*9+(CODE(LEFT(RIGHT(UPPER(A2),8)))-55)*8+LEFT(RIGHT(A2,7))*7+LEFT(RIGHT(A2,6))*6+LEFT(RIGHT(A2,5))*5+LEFT(RIGHT(A2,4))*4+LEFT(RIGHT(A2,3))*3+LEFT(RIGHT(A2,2))*2 RIGHT(A2)="A" 10

¦n³B¬O«Ü®e©ö´N¥i¥H¥Xdialog box prompt user
¥[­Ó¿ù»~ĵ§i´N¦æ