String Manipulation 1
- How to Remove unwanted characters from a string
- Code:
'This code removes unwanted characters from a string.
Function PurgeString(OldStr As String) As String
Dim NewStr As String
Dim l As Long
For l = 1 To Len(OldStr)
If Asc(Mid(OldStr, l, 1)) > 31 Then
NewStr = NewStr & Mid(OldStr, l, 1)
End If
Next
PurgeString = NewStr
End Function
- How to Test if a character is Alpha Numeric
- Code:
Public Function IsAlphaCharacter(ByVal sChar As String) As Boolean
'Returns true if the input letter is alphabetical in any code page or language.
IsAlphaCharacter = (Not (UCase$(sChar) = LCase$(sChar))) Or (sChar = " ")
End Function
- How to convert Numbers to words i.e., 44 = fourty four
- Code:
Option Explicit
'Return a string of words to represent the integer part of this value.
Public Function NumbersToWords(ByVal num As Currency) As String
Dim power_value(1 To 5) As Currency
Dim power_name(1 To 5) As String
Dim digits As Integer
Dim result As String
Dim i As Integer
' Initialize the power names and values.
power_name(1) = "trillion": power_value(1) = 1000000000000#
power_name(2) = "billion": power_value(2) = 1000000000
power_name(3) = "million": power_value(3) = 1000000
power_name(4) = "thousand": power_value(4) = 1000
power_name(5) = "": power_value(5) = 1
For i = 1 To 5
' See if we have digits in this range.
If num >= power_value(i) Then
' Get the digits.
digits = Int(num / power_value(i))
' Add the digits to the result.
If Len(result) > 0 Then result = result & ", "
result = result & Words_1_999(digits) & " " & power_name(i)
' Get the number without these digits.
num = num - digits * power_value(i)
End If
Next i
NumbersToWords = Trim$(result)
End Function
' Return words for this value between 1 and 999.
Public Function Words_1_999(ByVal num As Integer) As String
Dim hundreds As Integer
Dim remainder As Integer
Dim result As String
hundreds = num \ 100
remainder = num - hundreds * 100
If hundreds > 0 Then
result = Words_1_19(hundreds) & " hundred "
End If
If remainder > 0 Then
result = result & Words_1_99(remainder)
End If
Words_1_999 = Trim$(result)
End Function
' Return a word for this value between 1 and 19.
Public Function Words_1_19(ByVal num As Integer) As String
Select Case num
Case 1
Words_1_19 = "one"
Case 2
Words_1_19 = "two"
Case 3
Words_1_19 = "three"
Case 4
Words_1_19 = "four"
Case 5
Words_1_19 = "five"
Case 6
Words_1_19 = "six"
Case 7
Words_1_19 = "seven"
Case 8
Words_1_19 = "eight"
Case 9
Words_1_19 = "nine"
Case 10
Words_1_19 = "ten"
Case 11
Words_1_19 = "eleven"
Case 12
Words_1_19 = "twelve"
Case 13
Words_1_19 = "thirteen"
Case 14
Words_1_19 = "fourteen"
Case 15
Words_1_19 = "fifteen"
Case 16
Words_1_19 = "sixteen"
Case 17
Words_1_19 = "seventeen"
Case 18
Words_1_19 = "eightteen"
Case 19
Words_1_19 = "nineteen"
End Select
End Function
' Return a word for this value between 1 and 99.
Public Function Words_1_99(ByVal num As Integer) As String
Dim result As String
Dim tens As Integer
tens = num \ 10
If tens <= 1 Then
' 1 <= num <= 19
result = result & " " & Words_1_19(num)
Else
' 20 <= num
' Get the tens digit word.
Select Case tens
Case 2
result = "twenty"
Case 3
result = "thirty"
Case 4
result = "forty"
Case 5
result = "fifty"
Case 6
result = "sixty"
Case 7
result = "seventy"
Case 8
result = "eighty"
Case 9
result = "ninety"
End Select
' Add the ones digit number.
result = result & " " & Words_1_19(num - tens * 10)
End If
Words_1_99 = Trim$(result)
End Function
- How to count the number of occurrences of a substring inside another string
- Code:
Function InstrCount(Source As String, Search As String) As Long
' You get the number of substrings by subtracting the length of the
' original string from the length of the string that you obtain by
' replacing the substring with another string that is one char longer.
InstrCount = Len(Replace(Source, Search, Search & "*")) - Len(Source)
End Function
- How to replace only the LAST occurrence of a substring
- Code:
Function ReplaceLast(Source As String, Search As String, ReplaceStr As String) As String
ReplaceLast = StrReverse(Replace(StrReverse(Source), StrReverse(Search), _
StrReverse(ReplaceStr), , 1))
End Function
- How to use Replace function for VB5
- Code:
'If you are using VB5 and need Replace function that's available only in VB6,
'here is my version of it. Please let me know what you think.
Function fnReplace(ByVal InWhat As String, What As String, WithWhat As String) As String
Dim Pos As Long
Pos = InStr(InWhat, What)
While Pos
fnReplace = fnReplace & Left(InWhat, Pos - 1) & WithWhat
InWhat = Right(InWhat, Len(InWhat) - Pos - Len(What) + 1)
Pos = InStr(InWhat, What)
Wend
fnReplace = fnReplace & InWhat
End Function
- How to Scramble Word - Guaranteed different every time
- Code:
Public Function ScrambleWord(Word)
Randomize
Length = Len(Word)
ReDim Letter(Length)
For I = 1 To Length 5
RndSlot = Int(Rnd * Length) + 1
If RndSlot = Length + 1 Or Letter(RndSlot) <> "" Then
GoTo 5
Else
Letter(RndSlot) = Mid$(Word, I, 1)
End If
Next I
For I = 1 To Length
Scrambled = Scrambled & Letter(I)
Next I
ScrambleWord = Scrambled
End Function
- How to return a substring between two delimiters in a string
- Code:
'A simple parse function which returns in an array all words between two delimiters.
'if you have a string like strText="this is 'a test ' in order to'test'
'the function syntaxe'll be
'rs=Delimiter(strText,"'","'") if you want to get everything between the "'"
Dim rs() As String
Private Sub Form_Load()
Dim I As Integer
Dim strText As String
strText = "this is 'a test ' in order to'test'"
rs = Delimiter(strText, "'", "'")
For I = LBound(rs) To UBound(rs)
Debug.Print rs(I)
Next I
End Sub
Private Function Delimiter(ByVal texte As String, ByVal delimiter1 As String, ByVal delimiter2 As String) As Variant
Dim interne() As String
Dim cpt As Integer
Dim Flag1 As Boolean
Dim flag2 As Boolean
ReDim Preserve interne(1) 'initialisation du tableau à 1
qte = 1 'le premier composant du tableau en sortie aura l'index 1
Do While cpt < Len(texte)
cpt = cpt + 1
If Mid$(texte, cpt, 1) = delimiter1 And Not Flag1 Then
Flag1 = True
GoTo lenext
End If
If Mid$(texte, cpt, 1) = delimiter2 And Flag1 = True Then
Flag1 = False
flag2 = True
qte = qte + 1
ReDim Preserve interne(qte + 1)
GoTo lenext
End If
If Flag1 Then interne(qte) = interne(qte) & Mid$(texte, cpt, 1)
lenext:
Loop
Delimiter = interne
End Function
- How To Capitalize The First Character Of Each Word In A String/Phrase
- Code:
'Example Usage:
'Dim strTest As String
'strTest = "microsoft access 97"
'
'MakeInitialCaps strTest
'Debug.Print strTest 'Displays: "Microsoft Access 97"
Public Function MakeInitialCaps(ByRef strArg As String)
Const strSpace As String = " "
Dim ID As Long
'Remove Leading and Trailing Spaces
strArg = Trim$(strArg)
'Capitalize first letter in String
strArg = UCase(Left(strArg, 1)) & Mid(strArg, 2)
'Loop through string looking for spaces and
'Capitalizing the next Character
ID = 1 'Set index into string
Do
ID = InStr(ID, strArg, strSpace, _
vbBinaryCompare)
If ID > 0 Then
strArg = Left$(strArg, ID) & UCase$(Left$(Right$(strArg, Len(strArg) - ID), 1)) & Mid$(strArg, ID + 2)
ID = ID + 1
Else
Exit Do
End If
Loop
End Function
- How to Convert Dollar Amounts into Words
- Code:
Option Explicit
Dim Arr1 As Variant
Dim Arr10 As Variant
' Code good for 0 to 99999.99
Private Sub GetWords(Amt As Currency)
Dim d1 As Long
Dim d10 As Long
Dim d100 As Long
Dim d1000 As Long
Dim c1 As Long
Dim c10 As Long
Dim Words As String
Dim Amount As Double
Dim tmpAmt As Double
' Dollar Processing
Amount = Amt
d1000 = Int(Amount / 1000): Amount = Amount - (d1000 * 1000)
d100 = Int(Amount / 100): Amount = Amount - CDbl(d100 * 100)
d10 = Int(Amount / 10): Amount = Amount - CDbl(d10 * 10)
d1 = Int(Amount): Amount = Amount - d1
' Cents Processing
Amount = Amount * 100
c10 = Int(Amount / 10): Amount = Amount - (c10 * 10)
c1 = Int(Amount): Amount = Amount - c1
Words = ""
' Dollars Words Processing
If d1000 > 19 Then
Amount = d1000
Words = Words & Arr10(Int(d1000 / 10)): Amount = (d1000 Mod 10)
If Amount > 0 Then Words = Words & " " & Arr1(Amount)
Words = Words & " Thousand "
Else
If d1000 > 0 Then Words = Words & Arr1(d1000) & " Thousand "
End If
Words = Words & GetHundreds(d100)
'If d100 > 0 Then Words = Words & Arr1(d100) & " Hundred "
Words = Words & GetTens(d1, d10, " Dollars")
' Cents Words Processing
Words = Words & " and " & GetTens(c1, c10, " Cents")
MsgBox Words
Text1.Text = ""
End Sub
Function GetTens(iones As Long, itens As Long, stype As String) As String
Dim ones, tens As Integer
ones = iones
tens = itens
If ones > 0 And tens = 1 Then
GetTens = GetTens & Arr1(ones + (tens * 10)) & " "
ones = 0
Else
GetTens = GetTens & Arr10(tens) & " "
End If
If ones > 0 Then
GetTens = GetTens & Arr1(ones) & stype
Else
GetTens = "Zero" & stype
End If
End Function
Function GetHundreds(iHundreds As Long) As String
If iHundreds > 0 Then GetHundreds = Arr1(iHundreds) & " Hundred "
End Function
Private Sub Command1_Click()
GetWords CCur(Val(Text1.Text))
End Sub
Private Sub Form_Load()
Arr1 = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _
"Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", _
"Seventeen", "Eighteen", "Ninteen")
Arr10 = Array("", "Ten", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
End Sub
