I am trying to remove the first numbers of a string of characters (remove all numbers until first non-numerical character is reached). Some strings have starting numbers formatted in the form of "14 214" where it should read 14214. This is the special space for separating numbers, and if the string in A1 starts by 14 214 then
ISNUMBER(LEFT(A1,3)*1)=TRUE
So that means that the space is not a problem, I just have to check for the first non-numerical character.
I thought of the following VBA function:
Function RemoveNumbers(Txt As String) As String
i = 1
Do While i < 9
If (IsError(Left(Txt, i) * 1)) = "False" Then
i = i + 1
Else
RemoveNumbers = Right(Txt, Len(Txt) - i)
End If
Loop
End Function
But it returns #VALUE!
Is the function correctly written? Do you have any suggestions?
Thanks
Walk along the string from left to right, looking at each character.
If the char is a space do nothing, if its a number replace it with a space otherwise return the string with leading spaces removed:
Function RemoveNumbers(txt As String) As String
Dim i As Long
For i = 1 To Len(txt)
Select Case Mid$(txt, i, 1)
Case " ":
Case "0" To "9": Mid$(txt, i, 1) = " "
Case Else
Exit For
End Select
Next
RemoveNumbers = LTrim$(txt)
End Function
Good solution from Alex K.
I would just like to add that the basic problem with the original program was that iserror does not catch the number conversion error - as soon as that occurs the whole function exits and you just get a value error because RemoveNumbers is not set. Also the error doesn't occur when you have left(txt,i)="14 ", but only on the next character when you have left(txt,i)="14 2". To make it work you would have to do something like this
Function RemoveNumbers(Txt As String) As String
On Error GoTo Handler
i = 1
Do While i <= Len(Txt)
firstNumber = Left(Txt, i) * 1
i = i + 1
Loop
Handler:
RemoveNumbers = Right(Txt, Len(Txt) - i + 1)
End Function
Related
I am trying to create a program that parses an expression such as 3x^3 + 7x^2 + 6x - 9. I am using a recursive system to do this. At the moment, I'm just testing to see if I get the correct output for the expression I input by only using constants in the expression. The code works fine with most expressions, but when I have a minus followed by a positive, both terms are subtracted (first term should be subtracted, second term should be added). An example of this is entering 4*3^2-7*3+5*3. The answer to this is 30 but the program does 4*3^2-7*3-5*3 instead and outputs 0. I am unsure how to solve this.
Code:
Private Function ParseExpr(ByRef expression As String)
Dim op, op1 As Integer
op = ParseFactor(expression)
If expression.Length <> 0 Then
If (expression(0) = "+") Then
expression = expression.Substring(1, expression.Length - 1)
op1 = ParseExpr(expression)
op += op1
ElseIf (expression(0) = "-") Then
expression = expression.Substring(1, expression.Length - 1)
op1 = ParseExpr(expression)
op -= op1
End If
End If
Return op
End Function
All is well with raising to a power and multiplication. At that point we are simplified to 36-21+15. Here we must remember that we are adding -21. So we need to go back to -7 . When I build my list of numbers (it handles numbers of more than one digit) I add the minus sign to the number it precedes.
This code does not handle decimal numbers or parenthesis. I think you will be able to add the division operator, if you wish.
Private NumList As New List(Of Double)
Private OperatorList As New List(Of String)
Private Sub OpCode()
Dim Input = "14*3^2-7*3+15*3"
PopulateLists(Input)
Dim OpIndex As Integer
Dim NewNum As Double
Dim operators = {"^", "*", "+"} 'Note: no minus sign, the minus goes with the number
For Each op In operators
Do
OpIndex = OperatorList.IndexOf(op)
If OpIndex = -1 Then
Exit Do
End If
Select Case op
Case "^"
NewNum = NumList(OpIndex) ^ NumList(OpIndex + 1)
Case "*"
NewNum = NumList(OpIndex) * NumList(OpIndex + 1)
Case "+"
NewNum = NumList(OpIndex) + NumList(OpIndex + 1)
End Select
NumList.RemoveAt(OpIndex + 1)
NumList(OpIndex) = NewNum
OperatorList.RemoveAt(OpIndex)
Loop
Next
MessageBox.Show(NumList(0).ToString) 'Displays 150
End Sub
Private Sub PopulateLists(Input As String)
Dim strNum As String = ""
For Each c As Char In Input 'Be careful here, the IDE wants to add () at the end of this line - it doesn't belong
If Char.IsDigit(c) Then
strNum &= c
ElseIf c = "-" Then
OperatorList.Add("+") 'We are adding a negative number
NumList.Add(CDbl(strNum)) 'Add the last number we accumulated so we can start a new one with the minus sign
strNum = "-" 'Start a new number with the minus sign
Else 'The other operators are added to the list
OperatorList.Add(c)
NumList.Add(CDbl(strNum))
strNum = ""
End If
Next
NumList.Add(CInt(strNum)) 'The last number which will not be followed by an operator
End Sub
I have a access table and i am writing a vba code to remove non-ascii characters from the table, i have tried using below two functions
Public Function removeall(stringData As String) As String
Dim letter As Integer
Dim final As String
Dim i As Integer
For i = 1 To Len(stringData) 'loop thru each char in stringData
letter = Asc(Mid(stringData, i, 1)) 'find the char and assign asc value
Select Case letter 'Determine what type of char it is
Case Is < 91 And letter > 64 'is an upper case char
final = final & Chr(letter)
Case Is < 123 And letter > 96 'is an lower case char
final = final & Chr(letter)
Case Is = 32 'is a space
final = final & Chr(letter)
End Select
Next i
removeall = final
End Function
And also tried using below function
Public Function Clean(InString As String) As String
'-- Returns only printable characters from InString
Dim x As Integer
For x = 1 To Len(InString)
If Asc(Mid(InString, x, 1)) > 31 And Asc(Mid(InString, x, 1)) < 127 Then
Clean = Clean & Mid(InString, x, 1)
End If
Next x
End Function
But the problem is : In removeall function it removes everything including # and space characters.. And In Clean function also removes special characters as well.
I need a correct function which retains key board characters and removes all other characters
Examples of strings in tables are :
1) "ATTACHMENT FEEDING TUBE FITS 5-18 ºFR# "
2) "CATHETER FOLEY 3WAY SILI ELAST 20FR 30ML LATEXº"
Any help would be greatly appreciated
Output should be like
1) "ATTACHMENT FEEDING TUBE FITS 5-18 FR"
2) "CATHETER FOLEY 3WAY SILI ELAST 20FR 30ML LATEX"
One approach would be to use a whitelist of accepted characters. e.g.
' You can set up your domain specific list:
Const Whitelist = "1234567890" & _
"qwertyuiopasdfghjklzxcvbnm" & _
"QWERTYUIOPASDFGHJKLZXCVBNM" & _
" `~!##$%^&*()_-=+[]{};:""'|\<>?/ –"
Public Sub test()
Debug.Print Clean("ATTACHMENT FEEDING TUBE FITS 5-18 ºFR#")
Debug.Print Clean("CATHETER FOLEY 3WAY SILI ELAST 20FR 30ML LATEXº")
End Sub
Public Function isAllowed(char As String) As Boolean
isAllowed = InStr(1, Whitelist, char, vbBinaryCompare) > 0
End Function
Public Function Clean(dirty As String) As String
'-- Returns only printable characters from dirty
Dim x As Integer
Dim c As String
For x = 1 To Len(dirty)
c = Mid(dirty, x, 1)
If isAllowed(c) Then
Clean = Clean & c
End If
Next x
End Function
Alternate approach that preserves ALL ASCII characters, without working with a whitelist, in a single function:
Public Function RemoveNonASCII(str As String) As String
Dim i As Integer
For i = 1 To Len(str)
If AscW(Mid(str, i, 1)) < 127 Then 'It's an ASCII character
RemoveNonASCII = RemoveNonASCII & Mid(str, i, 1) 'Append it
End If
Next i
End Function
I've gotten stuck with this VBA code. Any help would be greatly appreciated. I'm trying to change the first letters of 2 words from lower case to upper case. Also, how should I take the space in between these two words into consideration in the code?
I haven't been able to execute the code as I keep getting this compile error: "Argument not optional".
Function Properword(Text)
Dim rText
rText = Len(rText)
If rText(Mid(1, 1)) = LCase(Str) Then
rText = UCase(Str)
If rText(Mid(6, 1)) = LCase(Str) Then
rText = UCase
End If
End Function
Cheers!
First of all, you don't have to use UDF. Simply use inbuilt WorksheetFunction.Proper function to achieve ProperCase.
If you still want to create UDF, an example would be
Function Properword(strTxt)
Dim arrTxt
arrTxt = Split(strTxt, " ")
For i = LBound(arrTxt) To UBound(arrTxt)
arrTxt(i) = UCase(Left(arrTxt(i), 1)) & Mid(arrTxt(i), 2)
Next
Properword = Join(arrTxt, " ")
End Function
Finally, issues with your code
rText = Len(rText) ~~ this means rText will contain a numeric value because Len returns the lenght of the string
If rText(Mid(1, 1)) = LCase(Str) Then ~~ Mid takes the string as first argument followed by start point and then end point (optional).
not sure what you were trying to do in the following lines.
rText = UCase(Str)
If rText(Mid(6, 1)) = LCase(Str) Then
rText = UCase
In addition to the Excel function PROPER
str = WorksheetFunction.Proper("UPPER lower") ' "Upper Lower"
There is also the VBA.StrConv function:
str = StrConv("UPPER lower", vbProperCase) ' "Upper Lower"
To convert only parts of the string to uppercase, you can use RegEx, or the Mid statement:
Mid(str, 1, 1) = UCase(Mid(str, 1, 1)) ' makes the first letter uppercase
I'm trying to shift letters to the end of the word. Like the sample output I have in the image.
Using getchar and remove function, I was able to shift 1 letter.
mychar = GetChar(word, 1) 'Get the first character
word = word.Remove(0, 1) 'Remove the first character
input.Text = mychar
word = word & mychar
output.Text = word
This is my code for shifting 1 letter.
I.E. for the word 'Star Wars', it currently shifts 1 letter, and says 'tar WarsS'
How can I make this move 3 characters to the end? Like in the sample image.
intNumChars = input.text
output.text = mid(word,4,len(word)) & left(word,3)
I wanted it to be easy for you to read but you can set the intNumChars variable to the value in your text box and replace the 4 with intNumChars + 1 and the 3 with intNumChars.
The mid() function can return a section of text in the middle of a string mid(string,start,finish). The len() function returns the length of a string so that the code will work on texts that are different lengths. The left function returns characters from the left() of a string.
I hope this is of some help.
You could write a that as a sort of permute, which maps each char-index to a new place in the range [0, textLength[
In order to do that you'll have to write a custom modulus as the Mod operator is more a remainder than a modulus (from a mathematical point of view, regarding how negative are handled)
With that you just need to loop over your string indexes and map each one to it's "offsetted" value modulo the length of the text
' Can be made local to Shift method if needed
Function Modulus(dividend As Integer, divisor As Integer) As Integer
dividend = dividend Mod divisor
Return If(dividend < 0, dividend + divisor, dividend)
End Function
Function Shift(text As String, offset As Integer) As String
' validation omitted
Dim length = text.Length
Dim arr(length - 1) As Char
For i = 0 To length - 1
arr(Modulus(i + offset, length) Mod length) = text(i)
Next
Return new String(arr)
End Function
That way you can easily handle negative values or values greater than the length of the text.
Note, the same thing is possible with a StringBuilder instead of an array ; I'm not sure which one is "better"
Function Shift(text As String, offset As Integer) As String
Dim builder As New StringBuilder(text)
Dim length = text.Length
For i = 0 To length - 1
builder(Modulus(i + offset, length) Mod length) = text(i)
Next
Return builder.ToString
End Function
Using Gordon's code did the trick. The left function visual studio tried to create a stub of the function, so I used the fully qualified function name when calling it. But this worked perfectly.
intNumChars = shiftnumber.Text
output.Text = Mid(word, intNumChars + 1, Len(word)) & Microsoft.VisualBasic.Left(word, intNumChars)
n = 3
output.Text = Right(word, Len(word) - n) & Left(word, n)
Hi I have a function that finds the longest common substring between two strings. It works great except it seems to break when it reaches any single quote mark: '
This causes it to not truly find the longest substring sometimes.
Could anyone help me adjust this function so it includes single quotes in the substring? I know it needs to be escaped someplace I'm just not sure where.
Example:
String 1: Hi there this is jeff's dog.
String 2: Hi there this is jeff's dog.
After running the function the longest common substring would be:
Hi there this is jeff
Edit: seems to also happen with "-" as well.
It will not count anything after the single quote as part of the substring.
Here's is the function:
Public Shared Function LongestCommonSubstring(str1 As String, str2 As String, ByRef subStr As String)
Try
subStr = String.Empty
If String.IsNullOrEmpty(str1) OrElse String.IsNullOrEmpty(str2) Then
Return 0
End If
Dim num As Integer(,) = New Integer(str1.Length - 1, str2.Length - 1) {}
Dim maxlen As Integer = 0
Dim lastSubsBegin As Integer = 0
Dim subStrBuilder As New StringBuilder()
For i As Integer = 0 To str1.Length - 1
For j As Integer = 0 To str2.Length - 1
If str1(i) <> str2(j) Then
num(i, j) = 0
Else
If (i = 0) OrElse (j = 0) Then
num(i, j) = 1
Else
num(i, j) = 1 + num(i - 1, j - 1)
End If
If num(i, j) > maxlen Then
maxlen = num(i, j)
Dim thisSubsBegin As Integer = i - num(i, j) + 1
If lastSubsBegin = thisSubsBegin Then
subStrBuilder.Append(str1(i))
Else
lastSubsBegin = thisSubsBegin
subStrBuilder.Length = 0
subStrBuilder.Append(str1.Substring(lastSubsBegin, (i + 1) - lastSubsBegin))
End If
End If
End If
Next
Next
subStr = subStrBuilder.ToString()
Return subStr
Catch e As Exception
Return ""
End Try
End Function
I tried it with dotnetfiddle and there it is working with your Code you posted. Please activate your warnings in your project. You have function with no return value and you return an integer or a string. This is not correct. How are you calling your function?
Here is my example I tested for you:
https://dotnetfiddle.net/mVBDQp
Your code works perfectly like Regex! As far as I can see, there is really nothing wrong with your code.
Here I even tested it under more severe case:
Public Sub Main()
Dim a As String = ""
Dim str1 As String = "Hi there this is jeff''s dog.-do you recognize this?? This__)=+ is m((a-#-&&*-ry$##! <>Hi:;? the[]{}re this|\ is jeff''s dog." 'Try to trick the logic!
Dim str2 As String = "Hi there this is jeff''s dog. ^^^^This__)=+ is m((a-#-&&*-ry$##! <>Hi:;? the[]{}re this|\ is jeff''s dog."
LongestCommonSubstring(str1, str2, a)
Console.WriteLine(a)
Console.ReadKey()
End Sub
Note that I put '-$#^_)=+&|\{}[]?!;:.<> all there. Plus I tried to trick your code by giving early result.
But the result is excellent!
You could probably put more actual samples on the inputs which give you problems. Else, you could possibly describe the environment that you use/deploy your code into. Maybe the problem lies elsewhere and not in the code.
The quickest way to solve this would be to use an escape code and replace all the ' with whatever escape code you use