My function on VBA does give some false negative output - vba

Recently, I wrote a code in order to check the Social Insurance Number issued in Germany.
I have 3 outputs: surname, dob and the given Social Insurance Number. Between 3rd and 8th digits it consists of date month and last two years of birth.
However, in some cases, it does return false negative. Can anyone suggest any improvements? I am very new to VBA and coding in general, that's why feel free to check and suggest any improvements.
I will post my code, an example where it gives true positive and examples where it does give false negatives.
__Steinbach 01.12.1991 12011291S533
false negative results for
Akyol 31.10.1993 13311093A017__
Voormann 22.11.1995 53221195V018__
Köhler 15.10.1997 14151097K056__
Xheladini 22.10.1991 65221091X509__
The function in Visual Basic
Public Function firstDigitsSocIn(surname As String, dob As Date, socialSecurityNumber As String) As String
'defining variables (add gender after surname when data is available)
Dim dayOfMonth As Integer
Dim monthSoc As Integer
Dim yearSoc As Integer
Dim firstCharSurname As String
Dim customMadeNumber As String
'Dim genderCode As Integer enable when having genders in data set
'Dim genderCheck As Boolean
Dim resultFirst7Chars As Boolean
Dim resultInclGenderCheck As Boolean
Dim resultFinal As Boolean
'setting up variables with correct values
dayOfMonth = Day(dob)
monthSoc = Month(dob)
yearSoc = Right(Year(dob), 2)
firstCharSurname = Left(surname, 1)
'genderCode = Left(Right(socialSecurityNumber, 3), 2)
'if gender = "M" am
'custommadenumber is composed using the credentials of the user
customMadeNumber = dayOfMonth & monthSoc & yearSoc & firstCharSurname
resultFirst7Chars = StrComp(Mid(socialSecurityNumber, 3, 7), customMadeNumber, vbBinaryCompare)
'If gender = "M" And genderCode < 50 Then
'genderCheck = True
'ElseIf gender = "F" And genderCode > 50 Then
'genderCheck = True
'Else
'genderCheck = False
'End If
'resultInclGenderCheck = resultFirst7Chars And genderCheck
'resultFinal = resultInclGenderCheck And True 'put Pruefziffer check here as well
firstDigitsSocIn = resultFirst7Chars
End Function

I think you have two severe problems.
You build your custom number with Integers instead of strings. That means that numbers less that 10 will lose their leading 0.
You use StrComp when you actually only want to check if strings are equal. That wouldn't be too bad but you are casting the result as Boolean (because resultFirst7Chars is a boolean). StrComp returns 0 if the strings are equal and -1 or +1 otherwise. But when you case 0, -1 and 1 as booleans you get False, True, and True, the exact opposite of what you want!
Prakash alreadygave a solution to the second problem. Another would be to just use
resultFirst7Chars = (socialSecurityNumber = customMadeNumber)
Edit: Since Prakash deleted his answer here is what he suggested:
resultFirst7Chars = (StrComp(Mid(socialSecurityNumber, 3, 7), customMadeNumber, vbBinaryCompare) = 0)
i.e. checking if StrComp returned 0 or not.
For the first problem, you could use dayOfMonth = Format(Day(dob), "00") to get leading zeros (Declare dayOfMonth and the others as strings or you will lose them again!)
Dim dayOfMonth As String
'...
Dim yearSoc As String
dayOfMonth = Format(Day(dob), "00")
'...
yearSoc = Right(CStr(Year(dob))) 'CStr wouldn't be necessary but this way it's more obvious what is happening.
Finally, your function should probably return a boolean instead of a string.

Related

How to skip DateTime conversion?

in VB.NET I have TextBox with masked time input such as
__:__
Before I save this to SQL database I have a conversion to iso format like:
Dim MyTime As DateTime = DateTime.ParseExact(txtMyTime.Text, "HH:mm", Nothing)
Dim isoMyTime As String = MyTime.ToString("HH:mm:ss")
Now my question is how to write to database Null value if this text box is empty without time value input?
not sure if you are stuck on SQL, or to figure out wether the textbox has been given a value.
when you write to database, you define the columns that you want to write to:
insert into Table1(Forename, Surname)
values(John, Jehnson)
if you want the surname to be null, simply do not mention it:
insert into Table1(Forename)
values(John)
Make sure your column is designed to allow nulls.
to figure out if the textbox has a value, simply Check if the values matches a actual valid format
solution 1
you can achieve this with a Regex:
[0-9]{2}:[0-9]{2}
this regex makes sure that there are 2 numbers before and after the : sign.
solution 2
You can also replace the textbox with 2 numericupdown controls.
solution 3
another option is to try to parse it manually.
dim ISvalid as boolean = true
if textbox1.contains(":")
if split(textbox1, ":").count = 2
if split(textbox1, ":").first.length = 2 andalso split(textbox1, ":").last.length = 2
if IsNumeric(split(textbox1, ":").first) andalso isnumeric(split(textbox1, ":").last
' this is a valid value
else
isvalid = false
end if
else
isvalid = false
end if
else
isvalid = false
end if
else
isvalid = false
end if
if isvalid then
Dim MyTime As DateTime = DateTime.ParseExact(txtMyTime.Text, "HH:mm", Nothing)
Dim isoMyTime As String = MyTime.ToString("HH:mm:ss")
end if

Visual basic palindrome code

I am trying to create an application which will determine whether a string entered by user is a palindrome or not.
Is it possible to do without StrReverse, possibly with for next loop. That's what i have done so far.
Working one, with StrReverse:
Dim userInput As String = Me.txtbx1.Text.Trim.Replace(" ", "")
Dim toBeComparedWith As String = StrReverse(userInput)
Select Case String.Compare(userInput, toBeComparedWith, True)
Case 0
Me.lbl2.Text = "The following string is a palindrom"
Case Else
Me.lbl2.Text = "The following string is not a palindrom"
End Select
Not working one:
Dim input As String = TextBox1.Text.Trim.Replace(" ", "")
Dim pallindromeChecker As String = input
Dim output As String
For counter As Integer = input To pallindromeChecker Step -1
output = pallindromeChecker
Next counter
output = pallindromeChecker
If output = input Then
Me.Label1.Text = "output"
Else
Me.Label1.Text = "hi"
End If
While using string reversal works, it is suboptimal because you're iterating over the string at least 2 full times (as string reversal creates a copy of a string because strings are immutable in .NET) (plus extra iterations for your Trim and Replace calls).
However consider the essential properties of a palindrome: the first half of a string is equal to the second half of the string in reverse.
The optimal algorithm for checking a palindrome needs only iterate through half of the input string - by comparing value[n] with value[length-n] for n = 0 to length/2.
In VB.NET:
Public Shared Function IsPalindrome(value As String) As Boolean
' Input validation.
If value Is Nothing Then Throw New ArgumentNullException("value")
value = value.Replace(" ", "") // Note String.Replace(String,String) runs in O(n) time and if replacement is necessary then O(n) space.
' Shortcut case if the input string is empty.
If value.Length = 0 Then Return False ' or True, depends on your preference
' Only need to iterate until half of the string length.
' Note that integer division results in a truncated value, e.g. (5 / 2 = 2)...
'... so this ignores the middle character if the string is an odd-number of characters long.
Dim max As Integer = value.Length - 1
For i As Integer = 0 To value.Length / 2
If value(i) <> value(max-i) Then
' Shortcut: we can abort on the first mismatched character we encounter, no need to check further.
Return False
End If
Next i
' All "opposite" characters are equal, so return True.
Return True
End Function

vb.net string contains only 4 digit numbers(or a year)

how can i check if a string only contains 4 digit numbers ( or a year )
i tried this
Dim rgx As New Regex("^/d{4}")
Dim number As String = "0000"
Console.WriteLine(rgx.IsMatch(number)) // true
number = "000a"
Console.WriteLine(rgx.IsMatch(number)) // false
number = "000"
Console.WriteLine(rgx.IsMatch(number)) //false
number = "00000"
Console.WriteLine(rgx.IsMatch(number)) // true <<< :(
this returns false when its less than 4 or at characters but not at more than 4
thanks!
I actually wouldn't use a regex for this. The expression is deceptively simple (^\d{4}$), until you realize that you also need to evaluate that numeric value to determine a valid year range... unless you want years like 0013 or 9015. You're most likely going to want the value as an integer in the end, anyway. Given that, the best validation is probably just to actually try to convert it to an integer right off the bat:
Dim numbers() As String = {"0000", "000a", "000", "00000"}
For Each number As String In numbers
Dim n As Integer
If Integer.TryParse(number, n) AndAlso number.Length = 4 Then
'It's a number. Now look at other criteria
End If
Next
Use LINQ to check if All characters IsDigit:
Dim result As Boolean = ((Not number Is Nothing) AndAlso ((number.Length = 4) AndAlso number.All(Function(c) Char.IsDigit(c))))
You should use the .NET string manipulation functions.
Firstly the requirements, the string must:
Contain exactly four characters, no more, no less;
Must consist of a numeric value
However your aim is to validate a Date:
Function isKnownGoodDate(ByVal input As String) As Boolean 'Define the function and its return value.
Try 'Try..Catch statement (error handling). Means an input with a space (for example ` ` won't cause a crash)
If (IsNumeric(input)) Then 'Checks if the input is a number
If (input.Length = 4) Then
Dim MyDate As String = "#01/01/" + input + "#"
If (IsDate(MyDate)) Then
Return True
End If
End If
End If
Catch
Return False
End Try
End Function
You may experience a warning:
Function isKnownGoodDate does not return a value on all code
paths. Are you missing a Return statement?
this can be safely ignored.

How do I split up a year range into individual years in a given field?

I was working in Access to make a query of a few tables, and realized that a column of a table does not meet a specific requirement.
I have a field that consists of thousands of records, and it contains "years" in the following format (an example) : 1915-1918.
What I want to accomplish is to make that value individual in the records. So
the end result would be : 1915,1916,1917,1918.
Basically, I want to convert 1915-1918 to 1915,1916,1917,1918.
I thought a simple concatenation would suffice, but could not wrap my head around how to make it so that it can do it for all thousands of records. I did some research and reached the conclusion that a user defined function might be the way to go. How would I go about this?
When your field value consists of 4 digits followed by a dash followed by 4 more digits, this function returns a comma-separated list of years.
In any other cases (Null, a single year such as "1915" instead of a year range, or anything else), the function returns the starting value.
Public Function YearList(ByVal pInput As Variant) As Variant
Dim astrPieces() As String
Dim i As Long
Dim lngFirst As Long
Dim lngLast As Long
Dim varReturn As Variant
If pInput Like "####-####" Then
astrPieces = Split(pInput, "-")
lngFirst = CLng(astrPieces(0))
lngLast = CLng(astrPieces(1))
For i = lngFirst To lngLast
varReturn = varReturn & "," & CStr(i)
Next
If Len(varReturn) > 0 Then
varReturn = Mid(varReturn, 2)
End If
Else
varReturn = pInput
End If
YearList = varReturn
End Function
However, this approach assumes the start year in each range will be less than the end year. In other words, you would need to invest more effort to make YearList("1915-1912") return a list of years instead of an empty string.
If that function returns what you want, you could use it in a SELECT query.
SELECT years_field, YearList(years_field)
FROM YourTable;
Or if you want to replace the stored values in your years field, you can use the function in an UPDATE query.
UPDATE YourTable
SET years_field = YearList(years_field);
You can use the Split function to return an array from the "years" field that contains the upper and lower year. Then loop from the lower year to the upper year and build the concatenated string. For example:
Public Function SplitYears(Years As String) As String
Dim v As Variant
Dim i As Long
Dim s As String
v = Split(Years, "-", 2)
If UBound(v) = 1 Then
For i = v(0) To v(1)
s = s & "," & CStr(i)
Next i
s = Right(s, Len(s) - 1)
Else
s = v(0)
End If
SplitYears = s
End Function
In Excel, make a sequential reference table of Years, for the range of years that you expect to encounter.
Next, use left and right functions to get the start and end of the range.
Create an update query and update the target field with a concatenation of target field to itself and then also the reference year values between that also fit between the start and end of the range.
Or I guess you could make a user function.
Add the code below to a module in Visual Basic
Public Function CommaDates(Start_End) As String
Dim strt As String
Dim endd As String
Dim x As Long
strt = Left(Start_End, 4)
endd = Right(Start_End, 4)
CommaDates = strt
For x = strt + 1 To endd
CommaDates = CommaDates & "," & x
Next x
End Function
Call this in a query like NEW_DATE: CommaDates([OLD_DATE_FIELD_NAME])

Run-time error "13": in my VBA excel code

I'm writing a script that will count a numbers of days between few separate dates. I have a data in cell like:
1-In Progress#02-ASSIGNED TO TEAM#22/01/2013 14:54:23,4-On
Hold#02-ASSIGNED TO TEAM#18/01/2013 16:02:03,1-In Progress#02-ASSIGNED
TO TEAM#18/01/2013 16:02:03
That's the info about my transaction status. I want to count the numbers of days that this transaction was in "4-On Hold". So in this example it will be between 18/01/2013 and 22/01/2013.
I wrote something like this(sorry for ma native language words in text)
Sub Aktywnywiersz()
Dim wiersz, i, licz As Integer
Dim tekstwsadowy As String
Dim koniectekstu As String
Dim pozostalytekst As String
Dim dataztekstu As Date
Dim status4jest As Boolean
Dim status4byl As Boolean
Dim datarozpoczecia4 As Date
Dim datazakonczenia4 As Date
Dim dniw4 As Long
wiersz = 2 'I start my scrypt from second row of excel
Do Until IsEmpty(Cells(wiersz, "A")) 'this should work until there is any text in a row
status4jest = False 'is status 4-On Hold is now in a Loop
status4byl = False 'is status 4-On Hold was in las loop
dniw4 = 0 ' numbers od days in 4-On Hold status
tekstwsadowy = Cells(wiersz, "H").Value2 'grabing text
tekstwsadowy = dodanieprzecinka(tekstwsadowy) 'in some examples I had to add a coma at the end of text
For i = 1 To Len(tekstwsadowy)
If Right(Left(tekstwsadowy, i), 1) = "," Then licz = licz + 1 'count the number of comas in text that separates the changes in status
Next
For j = 1 To licz
koniectekstu = funkcjaliczeniadni(tekstwsadowy) 'take last record after coma
Cells(wiersz, "k") = koniectekstu
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
Cells(wiersz, "m") = dataztekstu
status4jest = funkcjaokreslenia4(koniectekstu) 'check if there is 4-On Hold in record
Cells(wiersz, "n") = status4jest
If (status4byl = False And staus4jest = True) Then
datarozpoczecia4 = dataztekstu
status4byl = True
ElseIf (status4byl = True And staus4jest = False) Then
datazakonczenia4 = dataztekstu
status4byl = False 'if elseif funkcion to check information about 4-On Hold
dniw4 = funkcjaobliczeniadniw4(dniw4, datazakonczenia4, datarozpoczecia4) 'count days in 4-On Hold
Else
'Else not needed...
End If
tekstwsadowy = resztatekstu(tekstwsadowy, koniectekstu) 'remove last record from main text
Next
Cells(wiersz, "L") = dniw4 ' show number of days in 4-On Hold status
wiersz = wiersz + 1
Loop
End Sub
Function funkcjaliczeniadni(tekstwsadowy As String)
Dim a, dl As Integer
dl = Len(tekstwsadowy)
a = 0
On Error GoTo errhandler:
Do Until a > dl
a = Application.WorksheetFunction.Find(",", tekstwsadowy, a + 1)
Loop
funkcjaliczeniadni = tekstwsadowy
Exit Function
errhandler:
funkcjaliczeniadni = Right(tekstwsadowy, dl - a)
End Function
Function dodanieprzecinka(tekstwsadowy As String)
If Right(tekstwsadowy, 1) = "," Then
dodanieprzecinka = Left(tekstwsadowy, Len(tekstwsadowy) - 1)
Else
dodanieprzecinka = tekstwsadowy
End If
End Function
Function resztatekstu(tekstwsadowy, koniectekstu As String)
resztatekstu = Left(tekstwsadowy, Len(tekstwsadowy) - Len(koniectekstu))
End Function
Function funkcjadataztekstu(koniectekstu As String)
funkcjadataztekstu = Right(koniectekstu, 19)
funkcjadataztekstu = Left(funkcjadataztekstu, 10)
End Function
Function funkcjaobliczeniadniw4(dniw4 As Long, datazakonczenia4 As Date, datarozpoczecia4 As Date)
Dim liczbadni As Integer
liczbadni = DateDiff(d, datarozpoczecia4, datazakonczenia4)
funkcjaobliczaniadniw4 = dniw4 + liczbadni
End Function
Function funkcjaokreslenia4(koniectekstu As String)
Dim pierwszyznak As String
pierwszyznak = "4"
If pierszyznak Like Left(koniectekstu, 1) Then
funkcjaokreslenia4 = True
Else
funkcjaokreslenia4 = False
End If
End Function
And for now I get
Run-time error "13"
in
dataztekstu = funkcjadataztekstu(koniectekstu) 'take the date from this record
I would be very grateful for any help.
You are getting that error because of Type Mismatch. dataztekstu is declared as a date and most probably the expression which is being returned by the function funkcjadataztekstu is not a date. You will have to step through it to find what value you are getting in return.
Here is a simple example to replicate that problem
This will give you that error
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "Blah Blah"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
This won't
Option Explicit
Sub Sample()
Dim dt As String
Dim D As Date
dt = "12/12/2014"
D = getdate(dt)
Debug.Print D
End Sub
Function getdate(dd As String)
getdate = dd
End Function
If you change your function to this
Function funkcjadataztekstu(koniectekstu As String)
Dim temp As String
temp = Right(koniectekstu, 19)
temp = Left(temp, 10)
MsgBox temp '<~~ This will tell you if you are getting a valid date in return
funkcjadataztekstu = temp
End Function
Then you can see what that function is returning.
I tried running your code, but it is a little difficult to understand just what it is that you want to do. Part of it is the code in your language, but the code is also hard to read beacuse of the lack of indentation etc. :)
Also, I do not understand how the data in the worksheet looks. I did get it running by guessing, though, and when I did I got the same error you are describing on the second run of the For loop - that was because the koniectekstu string was empty. Not sure if this is your problem, so my solution is a very general.
In order to solve this type of problem:
Use Option Explicit at the top of your code module. This will make you have to declare all variables used in the module, and you will remove many of the problems you have before you run the code. Eg you are declaring a variable status4jest but using a different variable called staus4jest and Excel will not complain unless you use Option Explicit.
Declare return types for your functions.
Format your code so it will be easier to read. Use space before and after statements. Comment everything! You have done some, but make sure a beginner can understand. I will edit you code as an example of indentation.
Debug! Step through your code using F8 and make sure all variables contain what you think they do. You will most likely solve your problem by debugging the code this way.
Ask for help here on specific problems you run into or how to solve specific problems, do not send all the code and ask why it is not working. If you break down your problems into parts and ask separately, you will learn VBA yourself a lot faster.
A specific tip regarding your code: look up the Split function. It can take a string and make an array based on a delimiter - Example: Split(tekstwsadowy, ",") will give you an array of strings, with the text between the commas.
Did I mention Option Explicit? ;)
Anyway, I hope this helps, even if I did not solve the exact error you are getting.