New to VBA, pls, how can I make a function? (1 Viewer)

[powerniso]

Need to change into the function the repeated block in the code below:

______________________________________________________________

Private Sub Form_Open(Cancel As Integer)

Dim t As String, i As Integer, f, r As Double
Dim fs, d, k1

Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName (drvpath)))
k1 = d.SerialNumber
f = 0
name1 = name2
surname1 = surname2

If (Eval("([Forms]![ad]![name2] Is Null) Or ([Forms]![ad]![surname2] Is Null)")) Then
name1 = "Any"
surname1 = "User"
End If
For i = 1 To Len(name1 & surname1)
t = Mid(UCase(name1 & surname1), i, 1)
Select Case t
Case "A": r = 10
Case "B": r = 11
Case "C": r = 12
Case "D": r = 13
Case "E": r = 14
Case "F": r = 15
Case "G": r = 16
Case "H": r = 17
Case "I": r = 18
Case "J": r = 19
Case "K": r = 20
Case "L": r = 21
Case "M": r = 22
Case "N": r = 23
Case "O": r = 24
Case "P": r = 25
Case "Q": r = 26
Case "R": r = 27
Case "S": r = 28
Case "T": r = 29
Case "U": r = 30
Case "V": r = 31
Case "W": r = 32
Case "X": r = 33
Case "Y": r = 34
Case "Z": r = 35
End Select
f = f + r
Next i
key1 = Val(k1) + f
If key2 = Round(key1 / 5050505 * 99978877, 0) Then
DoCmd.Close acForm, "ad"
DoCmd.OpenForm "main", acNormal, "", "", , acDialog
Else:
DoCmd.GoToControl "name1"
End If
Set fs = Nothing
Set d = Nothing
End Sub
____________________________________________________________________

Private Sub name1_AfterUpdate()
Dim t As String, i As Integer, f, r As Double
Dim fs, d, k1

Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName (drvpath)))
k1 = d.SerialNumber
f = 0
For i = 1 To Len(name1 & surname1)
t = Mid(UCase(name1 & surname1), i, 1)
Select Case t
Case "A": r = 10
Case "B": r = 11
Case "C": r = 12
Case "D": r = 13
Case "E": r = 14
Case "F": r = 15
Case "G": r = 16
Case "H": r = 17
Case "I": r = 18
Case "J": r = 19
Case "K": r = 20
Case "L": r = 21
Case "M": r = 22
Case "N": r = 23
Case "O": r = 24
Case "P": r = 25
Case "Q": r = 26
Case "R": r = 27
Case "S": r = 28
Case "T": r = 29
Case "U": r = 30
Case "V": r = 31
Case "W": r = 32
Case "X": r = 33
Case "Y": r = 34
Case "Z": r = 35
End Select
f = f + r
Next i
key1 = Val(k1) + f
DoCmd.GoToControl "surname1"
Set fs = Nothing
Set d = Nothing
End Sub
______________________________________________________________________

Private Sub okey_Click()
If key2 = Round(key1 / 5050505 * 99978877, 0) Then
name2 = name1
surname2 = surname1
DoCmd.Close acForm, "ad"
DoCmd.OpenForm "main", acNormal, "", "", , acDialog
Else:
MsgBox "WRONG CODE !", vbOKOnly, "ERROR"
DoCmd.Quit acQuitSaveAll
End If
End Sub
_______________________________________________________________________

Private Sub surname1_AfterUpdate()
Dim t As String, i As Integer, f, r As Double
Dim fs, d, k1

Set fs = CreateObject("Scripting.FileSystemObject")
Set d = fs.GetDrive(fs.GetDriveName(fs.GetAbsolutePathName (drvpath)))
k1 = d.SerialNumber
f = 0
For i = 1 To Len(name1 & surname1)
t = Mid(UCase(name1 & surname1), i, 1)
Select Case t
Case "A": r = 10
Case "B": r = 11
Case "C": r = 12
Case "D": r = 13
Case "E": r = 14
Case "F": r = 15
Case "G": r = 16
Case "H": r = 17
Case "I": r = 18
Case "J": r = 19
Case "K": r = 20
Case "L": r = 21
Case "M": r = 22
Case "N": r = 23
Case "O": r = 24
Case "P": r = 25
Case "Q": r = 26
Case "R": r = 27
Case "S": r = 28
Case "T": r = 29
Case "U": r = 30
Case "V": r = 31
Case "W": r = 32
Case "X": r = 33
Case "Y": r = 34
Case "Z": r = 35
End Select
f = f + r
Next i
key1 = Val(k1) + f
DoCmd.GoToControl "key2"
Set fs = Nothing
Set d = Nothing
End Sub

The needed block is the one with "case"s. Thanx.

 

[stopher]

Lets say you want to pass the string fullName as an argument for your function and you want the function to return a value f.

Then your function will look like this (I've called it getf). You just copy and paste this along with your other code:

Public Function getf(fullName As String) As Integer
Dim i As Integer, t As String, r As Double
For i = 1 To Len(fullName)
t = Mid(UCase(fullName), i, 1)
Select Case t
Case "A": r = 10
Case "B": r = 11
Case "C": r = 12
Case "D": r = 13
Case "E": r = 14
Case "F": r = 15
Case "G": r = 16
Case "H": r = 17
Case "I": r = 18
Case "J": r = 19
Case "K": r = 20
Case "L": r = 21
Case "M": r = 22
Case "N": r = 23
Case "O": r = 24
Case "P": r = 25
Case "Q": r = 26
Case "R": r = 27
Case "S": r = 28
Case "T": r = 29
Case "U": r = 30
Case "V": r = 31
Case "W": r = 32
Case "X": r = 33
Case "Y": r = 34
Case "Z": r = 35
End Select
getf = getf + r
Next i
End Function

To use the function you would use the line:
f=getf("test message")

or
f=getf(name1 & surname1)


Some other points:
- You obviously need to remove the unwanted code and Dim statements
- r should be Dimed as an Integer not Double
- f should also be designated as an Integer

You could also use the fact that Asc("A")=65 i.e. ASC returns the ascii value. So instead of all the case statements you could just have:
r=ASC(t)-55


hth
Chris

 

[powerniso]

Lets say you want to pass the string fullName as an argument for your function and you want the function to return a value f.

Thanx for ur advices. I've used that function and everything worked. About the ASCII, I know, but I'm not using the values that I have given in the forum for letters. They are quite different in my code. Let it be my little secret.

Thanks again. Good luck...

 

[strihopciracc]

Thank you for your information and soon reply to my question.

 

[WayneRyan]

Replace:

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

With:

r = Asc(t) - 55

Wayne