Option Compare Database
Option Explicit
Public Function GetNumerologicalNo(InDate As Date) As Integer
Dim dd As Integer
dd = DatePart("d", InDate)
If dd > 9 And dd < 19 Then
dd = dd - 9
End If
If dd > 18 And dd < 29 Then
dd = dd - 18
End If
If dd > 28 And dd < 32 Then
dd = dd - 27
End If
GetNumerologicalNo = dd
End Function
Public Function GetSingleNumber(InputNo As Double) As Integer
Dim Length As Integer
Dim Inputnostr As String
Dim j As Integer
Dim OutNo As Integer
Inputnostr = Trim(Str(InputNo))
OutNo = 0
Length = Len(Inputnostr)
For j = 1 To Length
OutNo = OutNo + Mid(Inputnostr, j, 1)
Next j
Inputnostr = Trim(Str(OutNo))
Length = Len(Inputnostr)
OutNo = 0
For j = 1 To Length
OutNo = OutNo + Mid(Inputnostr, j, 1)
Next j
Inputnostr = Trim(Str(OutNo))
Length = Len(Inputnostr)
OutNo = 0
For j = 1 To Length
OutNo = OutNo + Mid(Inputnostr, j, 1)
Next j
GetSingleNumber = OutNo
End Function