In one Short Text column of a table such data was stored "any_text_N" where N is some number specific for each row.
I need to replace N by N+1.
Could any one provide query to do it?
Assuming (1) the number is always the rightmost characters, and (2) there is an underscore preceding the number, you can create a Function to parse the number and return the incremented value (see below).
Then to test it, create a query like follows (MAKE SURE YOU TEST FIRST!!!):
SELECT Table2.MyText, resetnbr([MyText]) AS NewVal
FROM Table2
WHERE (((Table2.MyText) Is Not Null));
Then to update your data:
UPDATE Table2 SET Table2.MyText= resetnbr([MyText])
WHERE (((Table2.MyText) Is Not Null));
Public Function ResetNbr(strIn As String) As String
'Assumes: (1) Number in rightmost position of string; (2) underscore preceeds number
Dim iLen As Integer
Dim i As Integer
Dim sNbr As String
If strIn = "" Then
ResetNbr = strIn
Exit Function
End If
iLen = Len(strIn)
For i = iLen To 1 Step -1
If Mid(strIn, i, 1) = "_" Then
Exit For
End If
Next i
If i > 1 Then
sNbr = Mid(strIn, i + 1, 99)
sNbr = sNbr + 1
ResetNbr = left(strIn, i) & sNbr
Else
' No underscore found!
ResetNbr = strIn
End If
End Function
Related
How can I create in VBA a String Const as HIGHVALUE? In Date it is e.g. 31.12.9999.
Const HIGHVALUE As String = "zzz"
Dim test As String
test = "zzzz"
If test <= HIGHVALUE Then
Debug.Print "equal or lower"
Else
Debug.Print "higher"
End If
test is higher than HIGHVALUE => so HIGHVALUE is not the highest possible string => it prints higher.
Set the length to above the maximum length you expect to test for, for example:
Const HIGHVALUE As String = "zzzzzzzz"
This is my solution to convert a String to numeric ASC, so that I could compare Strings then - anyway if there are special chars within or not:
Private Sub testGetASCValueOfString()
Debug.Print GetASCValueOfString("&$%§()[]}")
End Sub
Private Function GetASCValueOfString(test As String) As Variant
Dim i As Long, j As Long
GetASCValueOfString = 0
j = 1
For i = Len(test) To 1 Step -1
GetASCValueOfString = GetASCValueOfString + Asc(Mid$(test, i, 1)) * (j * 256)
j = j + 1
Next i
End Function
=> The advantage is, that now I don't need to compare Strings or need a String HIGHVALUE, because all is numeric now.
I have a Database with many columns, one of them containing Names.
My vb.net software acts as telegram server and waits for the user to send its full name.
The database could have its name spelled differently, for example "Marco Dell'Orso" could be spelled "Marco Dellorso" or "Marco Dell Orso" od "Dell Orso Marco" or whatever. The user could also misspell his name and invert two letters.. for esample "MaCRo Dell'Orso"
I would need a way to return the 5 rows that are the most similar to the words used in the query. What would be the best way? I was thinking of splitting the name on whitechars and then use LIKE in the query with the single words, but that does not work with mistyped words.
EDIT:
My current plan is to that if the database contains more than one or less then one rows with the exact name, then split the input into the single words and return all strings that contain ANY of the input words. this should reduce the rows to analyze from 42000 to a few hundred. Once I have these few hundred lines, i could run a Levenshtein function on the rows and return the 5 most matching..
Is this a good idea?
Solved it this way by combining my custom function with a premade Levenshtein function from this link: How to calculate distance similarity measure of given 2 strings? . I assign a score for each single word that appears in the other wordcomplex. then I add a score based on the Levenshtein comparison of each word to another. works great:
Public Class Form1
Private Sub TextBox1_KeyUp(sender As Object, e As KeyEventArgs) Handles TextBox1.KeyUp
calc()
End Sub
Private Sub TextBox2_KeyUp(sender As Object, e As KeyEventArgs) Handles TextBox2.KeyUp
calc()
End Sub
Sub calc()
Label1.Text = compare(TextBox1.Text, TextBox2.Text)
End Sub
Public Function compare(source As String, target As String) As Integer
Dim score As Double
Dim sourcewords As String() = source.Split(New Char() {" "c, "'"c, "`"c, "´"c})
Dim targetwords As String() = target.Split(New Char() {" "c, "'"c, "`"c, "´"c})
For Each s In sourcewords
If target.Contains(s) Then score = score + 1
For Each t In targetwords
score = score + 1 / (DamerauLevenshteinDistance(s, t, 100) + 1)
Next
Next
For Each s In targetwords
If source.Contains(s) Then score = score + 1
For Each t In sourcewords
score = score + 1 / (DamerauLevenshteinDistance(s, t, 100) + 1)
Next
Next
Return score
End Function
''' <summary>
''' Computes the Damerau-Levenshtein Distance between two strings, represented as arrays of
''' integers, where each integer represents the code point of a character in the source string.
''' Includes an optional threshhold which can be used to indicate the maximum allowable distance.
''' </summary>
''' <param name="source">An array of the code points of the first string</param>
''' <param name="target">An array of the code points of the second string</param>
''' <param name="threshold">Maximum allowable distance</param>
''' <returns>Int.MaxValue if threshhold exceeded; otherwise the Damerau-Leveshteim distance between the strings</returns>
Public Shared Function DamerauLevenshteinDistance(source As String, target As String, threshold As Integer) As Integer
Dim length1 As Integer = source.Length
Dim length2 As Integer = target.Length
' Return trivial case - difference in string lengths exceeds threshhold
If Math.Abs(length1 - length2) > threshold Then
Return Integer.MaxValue
End If
' Ensure arrays [i] / length1 use shorter length
If length1 > length2 Then
Swap(target, source)
Swap(length1, length2)
End If
Dim maxi As Integer = length1
Dim maxj As Integer = length2
Dim dCurrent As Integer() = New Integer(maxi) {}
Dim dMinus1 As Integer() = New Integer(maxi) {}
Dim dMinus2 As Integer() = New Integer(maxi) {}
Dim dSwap As Integer()
For i As Integer = 0 To maxi
dCurrent(i) = i
Next
Dim jm1 As Integer = 0, im1 As Integer = 0, im2 As Integer = -1
For j As Integer = 1 To maxj
' Rotate
dSwap = dMinus2
dMinus2 = dMinus1
dMinus1 = dCurrent
dCurrent = dSwap
' Initialize
Dim minDistance As Integer = Integer.MaxValue
dCurrent(0) = j
im1 = 0
im2 = -1
For i As Integer = 1 To maxi
Dim cost As Integer = If(source(im1) = target(jm1), 0, 1)
Dim del As Integer = dCurrent(im1) + 1
Dim ins As Integer = dMinus1(i) + 1
Dim [sub] As Integer = dMinus1(im1) + cost
'Fastest execution for min value of 3 integers
Dim min As Integer = If((del > ins), (If(ins > [sub], [sub], ins)), (If(del > [sub], [sub], del)))
If i > 1 AndAlso j > 1 AndAlso source(im2) = target(jm1) AndAlso source(im1) = target(j - 2) Then
min = Math.Min(min, dMinus2(im2) + cost)
End If
dCurrent(i) = min
If min < minDistance Then
minDistance = min
End If
im1 += 1
im2 += 1
Next
jm1 += 1
If minDistance > threshold Then
Return Integer.MaxValue - 1
End If
Next
Dim result As Integer = dCurrent(maxi)
Return If((result > threshold), Integer.MaxValue, result)
End Function
Private Shared Sub Swap(Of T)(ByRef arg1 As T, ByRef arg2 As T)
Dim temp As T = arg1
arg1 = arg2
arg2 = temp
End Sub
End Class
One way is to use the build-in soundex function of MySQL.
SELECT SOUNDEX(name) FROM table;
Or, the better way, there are a few MySQL-functions on the web implementing DoubleMetaphone. I think this is what you are searching:
GitHub
I'm using Join(Lookupset) to find unique group values which returns a sequence number. This is my function:
Join(LookupSet(Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value
, Fields!itemId.Value & Fields!UseByDate.Value & Fields!rackId.Value
, Fields!CustomerSeqNo.Value
, "PickingList"), ",")
The problem is on some items there are multiple transactions. I want to remove the duplicates.
I found a blog http://blogs.msdn.com/b/bobmeyers/archive/2012/06/18/creating-short-lists-using-the-lookupset-function.aspx but could not get SSRS Report Builder to reference Linq assembly. My issue is
How can I just show the unique values?
You don't need Linq, but you do still need custom code (in BIDS go to Report -> Report Properties -> Code)
You can put a RemoveDuplicates function in here, something like this:
Public Shared Function RemoveDuplicates(m_Array As Object()) As String()
System.Array.Sort(m_Array)
Dim k As Integer = 0
For i As Integer = 0 To m_Array.Length - 1
If i > 0 AndAlso m_Array(i).Equals(m_Array(i - 1)) Then
Continue For
End If
m_Array(k) = m_Array(i)
k += 1
Next
Dim unique As [String]() = New [String](k - 1) {}
System.Array.Copy(m_Array, 0, unique, 0, k)
Return unique
End Function
To use it in your Join:
Join(Code.RemoveDuplicates(LookupSet(...)),",")
I agree with #user3697615 that Report Code is best. However, I prefer to build it straight into a string:
public shared function JoinDistinct(
dups as object(),
delimiter as string
) as string
dim result as string = ""
system.array.sort(dups)
for i as integer = 0 to dups.length - 1
if i <> 0 then result += delimiter
if i = 0 orElse dups(i) <> dups(i-1) then result += dups(i)
next i
return result
end function
This way, we eliminate one nested function on the call:
=Code.JoinDistinct(LookupSet(...), ",")
If you're like me, you also want the elements in order based on frequency (descending order).
I created the following VisualBasic code to do so
Public Shared Function RemoveDuplicates(dataset As Object()) As String()
Dim unique As New System.Collections.Generic.List(Of String)
Dim frequency As New System.Collections.Generic.List(Of Integer)
For i As Integer = 0 To dataset.Length - 1
Dim index As Integer = -1
For j As Integer = 0 To unique.Count - 1
If dataset(i).Equals(unique(j)) Then
index = j
Exit For
End If
Next
If index < 0 Then
unique.Add(dataset(i))
frequency.Add(1)
Else
frequency(index) += 1
End If
Next
Dim uniqueArray As [String]() = unique.ToArray()
Array.Sort(frequency.ToArray(), uniqueArray)
Array.Reverse(uniqueArray)
return uniqueArray
End Function
This is based off others' answers where the SSRS expression is the following
Join(Code.RemoveDuplicates(LookupSet(...)),",")
Note: I learned VisualBasic in about an hour to solve this problem, so my algorithm probably isn't the most efficient.
I liked pwilcox's idea, so I wrote this one which filters out null and blank values.
Public Function JoinDistinct(arr As Object(), delimiter As String) As String
System.Array.Sort(arr)
Dim result As String = String.Empty
Dim lastvalue As String = String.Empty
For i As Integer = 0 To arr.Length - 1
If Not arr(i) Is Nothing And arr(i) <> lastvalue And arr(i) <> String.Empty Then
If result = String.Empty Then
result = arr(i)
Else
result = result + delimiter + arr(i)
End If
End If
lastvalue = arr(i)
Next
Return result
End Function
Usage:
=Code.JoinDistinct(LookupSet(...), ",")
I have a table linked to a form where a user enters an ISBN number. I'm checking to make sure the ISBN is valid. However, when I get to a point where I need to compare two numbers, I am incorrectly told that they do not match, when they definitely do match.
Private Sub isbn_BeforeUpdate(Cancel As Integer)
Dim isbn As String
Dim cleanIsbn As Double
Dim onlyIsbn As Double
Dim checkDigit As Integer
Dim legnth As Integer
length = 0
isbn = Forms!frmPubInfo!isbn.Value
' Strip out all hyphens
For i = 1 To Len(isbn)
Dim ch As String
ch = Mid(isbn, i, 1)
If IsNumeric(ch) Then
length = length + 1
Dim num As Integer
num = CInt(ch)
cleanIsbn = (cleanIsbn * 10) + num
End If
Next
' Check if 13 numbers
If length = 13 Then
Dim xBy3 As Boolean
Dim total As Integer
Dim calcCheckDigit As Integer
total = 0
xBy3 = False
' Calculate total amount
For j = 1 To 12
ch = Mid(cleanIsbn, j, 1)
If xBy3 = True Then
total = total + (ch * 3)
xBy3 = False
Else
total = total + ch
xBy3 = True
End If
Next
' Get calculated check digit
calcCheckDigit = 10 - (total Mod 10)
' Extract check digit
checkDigit = Mid(cleanIsbn, 13, 1)
' Debug output
MsgBox ("Actual CheckDigit: " & checkDigit & vbNewLine & _
"Calculated CheckDigit: " & calcCheckDigit)
' Check if check digit and calculated check digit match
If checkDigit <> calculatedCheckDigit Then
MsgBox ("checkDigit and calcCheckDigit are not the same")
Else
MsgBox ("They match! ISBN is good!")
End If
Else
' Display error
MsgBox ("Not enough numbers!")
End If
End Sub
When I get down to the 'Check if check digit and calculated check digit match', the If statement always says they don't match, even though the debug output above gives me the same two numbers.
I have tried:
Declaring the checkDigit variables as strings.
Casting the checkDigit variables as strings in the If Statement with CStr.
Casting the checkDigit variables as Integers in the If Statement with CInt.
I initially thought it was an issue with the data types, but if I'm casting them to the same type right as I'm comparing them, that can't be the issue, right?
This is all using Access 2013.
Man... I can't believe I didn't see this at first. I tested your code and got similar results as you. After looking at it closer I noticed that the if statement was wrong. In short you need to use Option Explicit and this error would have been caught. Option Explicit ensures that all variables are declared. In not an error is thrown.
You statement contains a null
If checkDigit <> calculatedCheckDigit Then
You dont have a variable called calculatedCheckDigit it should be calcCheckDigit.
If checkDigit <> calcCheckDigit Then
Just a side note: Your code for stripping out the hyphens obviously works but I offer this tweak.
' Dim as string since it is treated as one with Mid anyway.
' In practice Len didnt give accurate results while it was Double.
Dim cleanIsbn As String
' Strip out all hyphens
cleanIsbn = Replace(isbn, "-", "")
' Check if 13 numbers
If (Len(cleanIsbn) = 13) And IsNumeric(cleanIsbn) Then
' Process Stuff
Else
' Display error
MsgBox "Does not appear to be a valid ISBN value!"
End If
Take the isbn and just remove the hyphens with a replace. After that change if the result cleanIsbn is 13 characters long and numeric then you can assume its a good value to process.
ISBN Reference
I had to look it up but the math behind the ISBN numbers is located for reference here
I have been trying to figure this error out for the past few days with no luck. I am hoping one of you would be able to help. I am getting "value used in formula of wrong data type.
Quick explanation:
convert functions like this one to its corresponding text (20054/18393)*100.0
the 5 digit numbers are Field IDs that refer to questions.
ID Question
20054 How many days of year do you work
18393 How many days of vacation do you get a year
The result I am trying to get to is (How many days of year do you work / How many days of vacation do you get a year) *100.0
It could be easily done manually if it was just a hand full. I have over 2600 formulas that need to be converted.
I created this function below which is resulting in the error mentioned in the title. Any assistance would be greatly appreciated
Here is my function
Function Test(sInput As String) As String
Dim i As Long
Dim num As String
Dim Text, a, str, shortname As String
For i = 1 To Len(sInput)
a = Mid(sInput, i, 1)
If IsNumeric(a) Then
num = num & a
Text = ""
Else
If a = "." Then
num = num & a
Else
'search for num value in second sheet short name
shortname = WorksheetFunction.VLookup(WorksheetFunction.Int(num), Worksheets("questionlist").Range("A3:F2537"), 5, False)
num = ""
End If
Text = shortname & a
shortname = ""
End If
str = str & Text
Next
Test = str
End Function
The error is raised because you are passing blank value to INT Function in the line
WorksheetFunction.VLookup(WorksheetFunction.Int(num), Worksheets("questionlist").Range("A3:F2537"), 5, False)
To reproduce the error Type =INT("") in any cell
To fix this handle blank values
Updated Answer:
Function Formula2Text(ByRef myCell As Range) As String
Dim QuestionId As Integer
Dim strInput As String
'Get Formula instead of values
strInput = myCell.FormulaR1C1
'Use Regex to Catch all ID's
Set Regex = CreateObject("VBScript.RegExp")
Set rnglookup = Worksheets("questionlist").Range("A3:F2537")
Regex.Global = True
Regex.Pattern = "\d+"
For Each Match In Regex.Execute(strInput)
'Skip if the ID is 100
If (Match.Value <> 100) Then QuestionId = Match.Value
'Lookup ID in the rnglookup,Make sure the Ids are sorted in asc in the questionlist sheet
Qntxt = Application.VLookup(QuestionId, rnglookup, 5, False)
If IsError(Qntxt) Then Qntxt = "Missing Lookup"
'Replace the ID with the lookup
strInput = Replace(strInput, QuestionId, Qntxt)
Next
Formula2Text = strInput
End Function
Usage:In the cell next to the formula use the function by referencing the formula
=Formula2Text(A1)