Page 1 of 2 12 LastLast
Results 1 to 15 of 16
  1. #1
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Calculate CIN (2000 sr 1)

    Hans peraphs this is the one of mine question very hard... and i hope only you solve this.
    This sheet contain a macro "CALCOLOCINCOPE".
    In the column A i have insert some value.
    The macro calculate the letter for every number (is a CIN)
    In effect all calculation is based on the rest of a division (/) and a multiplicate value (*) ...

    Is possible to integrate or modify (with your experince) this routine for this variable:

    var_COPE = Mid(riga, 22, 8)

    and put the result into:

    Foglio1.Range("G" & Trim(Str(cont))).Value = var_COPE

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Calculate CIN (2000 sr 1)

    Copy the following function into a module:

    Function CalcoloCin(strVal As String) As String
    Dim strNumero As String
    Dim strCope As String
    Dim intMod As Integer

    strNumero = Right(strVal, 6)
    strCope = Left(strVal, (Len(strVal) - 6))

    intMod = strNumero Mod 13
    Select Case intMod
    Case 0
    strNumero = strNumero & "N"
    Case 1 To 8
    strNumero = strNumero & Chr(64 + intMod)
    Case Else
    strNumero = strNumero & Chr(65 + intMod)
    End Select

    CalcoloCin = Right("00" & strCope & strNumero, 9)
    End Function

    and change the line

    Foglio1.Range("G" & Trim(Str(cont))).Value = var_COPE

    to

    Foglio1.Range("G" & Trim(Str(cont))).Value = CalcoloCin(var_COPE)

  3. #3
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    Is possible: error in By ref

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Calculate CIN (2000 sr 1)

    Change the first line of the function to

    Function CalcoloCin(ByVal strVal As String) As String

  5. #5
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    Good code... Only You.
    Very good, impression for solution.

  6. #6
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    ... Hans about this function is possible to autocalculate CIN after i have insert the 8 digit in a tetxbox of useform and insert in the same textbox the cin in just value inserted????
    Hope understand me.
    Tks.

  7. #7
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Calculate CIN (2000 sr 1)

    Say your text box is named TextBox1. Create an After Update event procedure:

    Private Sub TextBox1_AfterUpdate()
    On Error GoTo ErrHandler
    ' Ignore values of less than 6 characters
    If Len(Me.TextBox1) < 6 Then
    Exit Sub
    End If
    ' Calculate CIN
    Me.TextBox1 = CalcoloCin(Me.TextBox1)
    Exit Sub

    ErrHandler:
    If Not Err = 13 Then
    MsgBox Err.Description, vbExclamation
    End If
    End Sub

  8. #8
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    tks!!!!!!!!!!!!

  9. #9
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    Hi Hans.. remember this SPECTACULAR function.... i use tath in all my application!!!!
    Now..
    About this code is possible to controll if user insert a COPE wrong?
    Example:
    COPE = 45000001 the CIN is only and only A
    Now
    If i have a textbox and permit insertion of COPE if user insert 45000001B naturally the COPE is wrong because with this function the correct result is 45000001A...
    Hope you have undesrtand me...
    Tks for all.

  10. #10
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Calculate CIN (2000 sr 1)

    You could test whether the user has entered a number:

    If Not IsNumeric(Me.TextBox1) Then
    MsgBox "Only numbers allowed", vbCritical
    Me.TextBox1 = ""
    Else
    ...
    End If

  11. #11
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    Hans i use this subroutine about 2 years and work great
    Now have a new calculation similar CIN of Cope
    But difficult to cheange it...

    This is a list without CIN

    011671613
    010581256
    013551903

    and this the list with CIN

    011671613E
    010581256K
    013551903A

    i dont know the Algorit to calculate the new CIN

    note:
    The calculation is similar the old routine...

  12. #12
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Calculate CIN (2000 sr 1)

    I can't write code without knowing the algorithm, obviously.

  13. #13
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    Sorry old my code:
    Sub CALCOLOCINCOPLIST()

    RIGA = 1

    While Not Range("A" + RIGA) = ""
    NUMERO = Range("A" + RIGA)

    If NUMERO - Int(NUMERO / 13) * 13 = 1 Then
    NUMERO = NUMERO + "A"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 2 Then
    NUMERO = NUMERO + "B"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 3 Then
    NUMERO = NUMERO + "C"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 4 Then
    NUMERO = NUMERO + "D"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 5 Then
    NUMERO = NUMERO + "E"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 6 Then
    NUMERO = NUMERO + "F"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 7 Then
    NUMERO = NUMERO + "G"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 8 Then
    NUMERO = NUMERO + "H"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 9 Then
    NUMERO = NUMERO + "J"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 10 Then
    NUMERO = NUMERO + "K"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 11 Then
    NUMERO = NUMERO + "L"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 12 Then
    NUMERO = NUMERO + "M"
    GoTo FINE
    End If
    If NUMERO - Int(NUMERO / 13) * 13 = 0 Then
    NUMERO = NUMERO + "N"
    GoTo FINE
    End If

    FINE:


    NUMERO = Right("000000000" + NUMERO, 10)
    Range("A" + RIGA) = NUMERO

    RIGA = RIGA + 1

    Wend

    MsgBox ("CALCOLO CIN TERMINATO")

    End Sub

  14. #14
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Calculate CIN (2000 sr 1)

    So what is the problem?

  15. #15
    Gold Lounger
    Join Date
    Jan 2004
    Location
    Italy
    Posts
    3,245
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Calculate CIN (2000 sr 1)

    Instead the code posted CALCOLOCINCOPLIST is possible to have a funcion similar:

    Function CalcoloCin(strVal As String) As String
    Dim strNumero As String
    Dim strCope As String
    Dim intMod As Integer

    strNumero = Right(strVal, 6)
    strCope = Left(strVal, (Len(strVal) - 6))

    intMod = strNumero Mod 13
    Select Case intMod
    Case 0
    strNumero = strNumero & "N"
    Case 1 To 8
    strNumero = strNumero & Chr(64 + intMod)
    Case Else
    strNumero = strNumero & Chr(65 + intMod)
    End Select

    CalcoloCin = Right("00" & strCope & strNumero, 9)
    End Function

Page 1 of 2 12 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •