my Question is how to check if a string have a "text" & "_" at beginning.
For Example:
If sText = test.docx Then Function = False
ElseIF sText = Test_test.docx Then Function = True
End If
how i cut this string correctly, also when the text before the _ is not test and if there are several _ in the string it also works
use Instr() as shown here:
foo="test"&"_"
bar="test_test.docx"
if Instr(bar, foo)>0 then function = true
else function = false
end if
Instr(bar,foo) shows position of substring foo in string bar.
If there s no such substring, then it returns zero
If you need to check any text, that is not a problem, use this condition:
foo="_"
n=4
bar"test_textt.docx"
m=Instr(bar,foo)
if (m>n)and(len(bar)>m) then function=true
else function=false
end if
here n - number of characters, that would be before ""
If you dont know how many characters there may be, just set n to 0 or 1
if "" migth be last character, then delete condition (len(bar)>m)
You can simply check if the string begin with test_
dim res as boolean, filename as string
res = false
filename = ""
' if the len is not Superior to 5 (len of test_), don't check
if len(sText) > 5 then
' if the left part begin with test_
if left(lcase(sText), 5) = "test_" then
res = true
' if you want to retrieve the filename without test
filename = mid(sText, 6)
end if
end if
Related
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 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
My application is downloading many diffrent files from network. There is possibility that some of the files could contain additional number within brackets like below:
report78-12-34-34_ex 'nothing to be removed
blabla3424dm_d334(7) '(7) - to be removed
erer3r3r3_2015_03_03-1945-user-_d334(31).xml '(31) - to be removed
group78-12-34-34_ex.html 'nothing to be removed
somereport5_6456 'nothing to be removed
As you see if (number) appear within filename it has to be removed. Do you have some nice secure method which could do the job?
I got some code from rakesh but it is not working when string doesn't contain (number):
string test="something(3)";
test=Regex.Replace(test, #"\d", "").Replace("()","");
Not working when e.g:
if i place file like this: UIPArt3MilaGroupUIAPO34mev1-mihe-2015_9_23-21_30_5_580.csv then it will show: UIPArtMilaGroupUIAPOmev-mihe--_.csv
And i would prefer not using regex.
Avoids Regex and checks the string inside the parentheses, only removing the substring if the enclosed string is a number.
Private Function NewFileName(ByVal FileName As String) As String
If FileName Like "*(*)*" Then
Try
Dim SubStrings() As String = Split(FileName, "(", 2)
NewFileName = SubStrings(0)
SubStrings = Split(SubStrings(1), ")", 2)
SubStrings(0) = NewFileName(SubStrings(0))
SubStrings(1) = NewFileName(SubStrings(1))
If IsNumeric(SubStrings(0)) Then
NewFileName &= SubStrings(1)
Else
Return FileName
End If
Catch
Return FileName
End Try
Else
Return FileName
End If
End Sub
I would do something like this:
Public Function GetFileName(ByVal fileName As String) As String
Dim lastOpenBracketPos As Integer = fileName.LastIndexOf("(")
Dim lastCloseBracketPos As Integer = fileName.LastIndexOf(")")
If lastOpenBracketPos <> -1 AndAlso lastCloseBracketPos <> -1 AndAlso lastCloseBracketPos > lastOpenBracketPos Then
Dim bracketsText As String = fileName.Substring(lastOpenBracketPos, lastCloseBracketPos-lastOpenBracketPos+1)
If IsNumeric(bracketsText.Trim("(",")")) Then
Return fileName.Replace(bracketsText,"")
End If
End If
Return fileName
End Function
Out of all code here i made out my own one because it has to be ensured that before every playing with filename first has to be checked how many brackets within filename - only if 1 for open and 1 for close bracket is there then go with checking. What do you think is there any issue i don;t see or something which could be tuned up?
Private Function DeleteBrackets(ByVal fn As String) As String
Dim countOpenBracket As Integer = fn.Split("(").Length - 1
Dim countCloseBracket As Integer = fn.Split(")").Length - 1
'-- If only one occurence of ( and one occurence of )
If countOpenBracket = 1 And countCloseBracket = 1 Then
Dim filextension = IO.Path.GetExtension(fn)
Dim filewithoutExtension As String = IO.Path.GetFileNameWithoutExtension(fn)
'Debug.Print("Oryginal file name = " & fn)
'Debug.Print("File name without extension = " & filewithoutExtension)
'Debug.Print("Extension = " & IO.Path.GetExtension(fn))
If filewithoutExtension.EndsWith(")") Then
fn = filewithoutExtension.Remove(filewithoutExtension.LastIndexOf("("))
'Debug.Print("After removing last index of ( = " & fn)
'Debug.Print("Adding again extension = " & fn & filextension)
End If
'Debug.Print(fn)
End If
Return fn
End Function
I have a list of full names in a column like for example:
Dave M. Butterworth
Dave M. Butterworth,II
H.F. Light jr
H.F. Light ,jr.
H.F. Light sr
Halle plumerey
The names are in a column. The initials are not limited to these only.
I want to extract the last name using a generic function. Is it possible?
Consider the following UDF:
Public Function LastName(sIn As String) As String
Dim Ka As Long, t As String
ary = Split(sIn, " ")
Ka = UBound(ary)
t = ary(Ka)
If t = "jr" Or t = ",jr" Or t = "sr" Or t = ",jr." Then
Ka = Ka - 1
End If
t = ary(Ka)
If InStr(1, t, ",") = 0 Then
LastName = t
Exit Function
End If
bry = Split(t, ",")
LastName = bry(LBound(bry))
End Function
NOTE:
You will have to expand this line:
If t = "jr" Or t = ",jr" Or t = "sr" Or t = ",jr." Then
to include all other initial sets you wish to exclude.You will also have to update this code to handle other exceptions as you find them !
Remove punctuation, split to an array and walk backwards until you find a string that does not match a lookup of ignorable monikers like "ii/jr/sr/dr".
You could also add a check to eliminate tokens based on their length.
Function LastName(name As String) As String
Dim parts() As String, i As Long
parts = Split(Trim$(Replace$(Replace$(name, ",", ""), ".", "")), " ")
For i = UBound(parts) To 0 Step -1
Select Case UCase$(parts(i))
Case "", "JR", "SR", "DR", "I", "II"
Case Else:
LastName = parts(i)
Exit Function
End Select
Next
End Function
I need to compare two formatted strings. The text in the two of them is the same, only the formatting differs, meaning that some words are bold. The code should tell me if the location of the bold substrings are different e.g. the strings are formatted differently.
So far I tried a char-to-char approach, but it is far too slow.
It's a plain legal current text in MS Word, with cca 10-500 chars per string. Two people independently formatted the strings.
my code so far:
Function collectBold(r As Range) As String
Dim chpos As Integer
Dim ch As Variant
Dim str, strTemp As String
chpos = 1
Do
If r.Characters(chpos).Font.Bold Then
Do
Dim boold As Boolean
strTemp = strTemp + r.Characters(chpos)
chpos = chpos + 1
If (chpos < r.Characters.Count) Then boold = r.Characters(chpos).Font.Bold
Loop While (boold And chpos < r.Characters.Count)
str = str + Trim(strTemp) + "/"
strTemp = ""
Else: chpos = chpos + 1
End If
Loop While (chpos < r.Characters.Count)
collectBold = str
End Function
This code collect all bold substrings (strTemp) and merges them into one string (str), separating them with "/". The function runs for both strings to compare, and then checks if the outputs are the same.
If you only need to see if they are different, this function will do it:
Function areStringsDifferent(range1 As Range, range2 As Range) As Boolean
Dim i As Integer, j As Integer
For i = 1 To range1.Words.Count
'check if words are different formatted
If Not range1.Words(i).Bold = range2.Words(i).Bold Then
areStringsDifferent = True
Exit Function
'words same formatted, but characters may not be
ElseIf range1.Words(i).Bold = wdUndefined Then
For j = 1 To range1.Words(i).Characters.Count
If Not range1.Words(i).Characters(j).Bold = range2.Words(i).Characters(j).Bold Then
areStringsDifferent = True
Exit Function
End If
Next
End If
Next
areStringsDifferent = False
End Function
It first looks if the words are different formatted... If they have the same format but the format is undefinied, it looks into the characters of the word.