hi i have this problem finding a string on a text box
so far this what i have it only detect the comma char, now i i input 23pm,24,25am how will i do this with this code or anybody can give me the simple code?
Dim tdates() As String
Dim numberOfDates, xcount As Integer
tdates = Split(TXTDAYS.Text, ",")
numberOfDates = UBound(tdates)
Dim counter As Integer
' loop through each input
For counter = 0 To numberOfDates
Dim xdate As String
xdate = LCase$(tdates(counter))
If Len(xdate) <= 2 Then
xcount = xcount + 1
Else
' if the original text has am or pm in it, add .5
If InStr(1, xdate, "am") > 0 Or InStr(1, xdate, "pm") > 0 Then
xcount = xcount + 0.5 'problem here it doesn't count
End If
End If
Next
if there is a better way to do this by detecting the comma and the am pm string much better.
Split the text on comma. Then your array will have all of the whole words in it
Use InStr to search for am or pm.
Replace AM and PM with "" and check the remainder of the text for a number (for validating)
' split the input on a comma.
dim dates() as String = Split(TXTDAYS.Text, ",")
dim numberOfDates as Integer = UBound(dates)
dim counter as Integer
' loop through each input
For counter = 0 to numberOfDates
dim dateEntered as String = LCase$(dates(counter))
' make sure the text entered is a number (once am and pm are removed)
dim dateNumber as String = Replace(Replace(dateEntered, "pm", ""), "am", "")
if IsNumeric(dateNumber) Then
COUNT = COUNT + 1
' if the original text has am or pm in it, add .5
if Instr(1, dateEntered , "am") > 0 Or Instr(1, dateEntered , "pm") > 0 Then
COUNT = COUNT + .5
end if
else
' do something to indicate invalid input
end if
Next
using instr()..
s = "admin#foo.com"
d = Mid(s, InStr(1, s, "#") + 1)
The variable d$ would end up with the string "foo.com". (Don't forget to check to make sure that the # sign is present, otherwise you would just end up with the whole source string.)
taken from this post..
VB6 Index of Substring
Thanks!
#leo
Related
Consider the following text string:
(*4,14)(7,15)(10,13)(9,12)-(1,8)(2,6)-5,3-11
My goal is to count how many left brackets ("("), commas outside brackets, and hyphens before each individual number in this string (e.g., 3 left brackets in front of the number 10, 6 left brackets and 3 hyphens in front of 11).
My current solution is to first recall the remaining text string in front of each individual number, simply =LEFT(A1,(FIND("1",A1,1)-1)), but it happens that Excel will recall the string appeared before the first "1" (i.e., (*4,), instead of recalling the remaining string from the actual number "1" in the string (i.e., (*4,14)(7,15)(10,13)(9,12)-().
Side note, any idea on how to count the number of commas that are outside of brackets?
Help would be much appreciate!
If you have a version of Excel with the FILTERXML function (Windows Excel 2013+), you can use:
=SUM(LEN(FILTERXML("<t>" & SUBSTITUTE(SUBSTITUTE(A1,"(","<s>"),")","</s>") & "</t>","//t")))- LEN(SUBSTITUTE(FILTERXML("<t>" & SUBSTITUTE(SUBSTITUTE(A1,"(","<s>"),")","</s>") & "</t>","//t"),",",""))
The formula creates an xml where the s nodes are what's included inside the parentheses, and the t node is everything else.
If you don't have the FILTERXML function, a VBA solution would be best. Which depends on your version of Excel, and whether it is Windows or MAC.
Count Chars
Option Explicit
Function countChars(SourceString As String, SourceNumber As Variant, _
CountChar As String, Optional countRight As Boolean = False) As Long
Dim NumberDouble As Double
Dim NumberString As String
Dim NumberLength As Long
Dim StringLength As Long
Dim CurrentStart As Long
Dim CurrentFound As Long
Dim i As Long
Dim isFound As Boolean
StringLength = Len(SourceString)
If VarType(SourceNumber) = 8 Then
If Not IsNumeric(SourceNumber) Then _
Exit Function ' SourceNumber is not numeric.
End If
NumberDouble = Val(SourceNumber)
If NumberDouble <> Int(NumberDouble) Then _
Exit Function ' SourceNumber is not an integer.
NumberString = CStr(NumberDouble)
NumberLength = Len(NumberString)
CurrentStart = 1
Do
CurrentFound = InStr(CurrentStart, SourceString, NumberString)
GoSub checkNumber
If isFound Then
GoSub countTheChars
Exit Do
End If
CurrentStart = CurrentFound + 1
Loop Until CurrentFound = 0
Exit Function
countTheChars: ' Can be written better.
If Not countRight Then
For i = 1 To CurrentFound - 1
If Mid(SourceString, i, 1) = CountChar Then
countChars = countChars + 1
End If
Next i
Else
For i = CurrentFound + 1 To StringLength
If Mid(SourceString, i, 1) = CountChar Then
countChars = countChars + 1
End If
Next i
End If
checkNumber: ' Check for adjacent numbers.
Select Case CurrentFound
Case 0: Exit Function ' NumberString (initially) not found.
Case 1 ' NumberString found at the beginning.
isFound = Not _
IsNumeric(Mid(SourceString, CurrentFound + NumberLength, 1))
Case StringLength - NumberLength + 1 ' NumberString found at the end.
isFound = Not _
IsNumeric(Mid(SourceString, CurrentFound - 1, 1))
Case Else ' NumberString found in the middle.
isFound = Not _
IsNumeric(Mid(SourceString, CurrentFound + NumberLength, 1)) _
And Not IsNumeric(Mid(SourceString, CurrentFound - 1, 1))
End Select
Return
End Function
I've the following Excel data:
A B C
+ ------------ ------------- -----------------
1 | WORD WORD MIX MATCH TEXT RESULT
2 | somewordsome emsomordsowe ...
3 | anotherword somethingelse ...
4 | ... ... ...
I'd like to:
Firstly, get an array, say ArrayOfGroups, by splitting the string in the A2 cell in unique groups of 2 to 12 adjacent chars (note: 2 is the minimum number of chars to form a group; 12 is the total number of the word's chars) i.e. the groups of 2 chars would be so, om, me, ew, wo, or, rd, ds (note: the last so, om and me groups are excluded because they are repeated); the groups of 3 chars would be som, ome, mew, ewo, wor, ord, rds, dso (last som and ome excluded); the groups of 4 chars would be some, omew, mewo, ewor, word, ords, rdso, dsom; ... and so on until the full string somewordsome.
Then, iterate the above-mentioned ArrayOfGroups to check if each of its element is a substring of the B2 cell and return a new array, say ArrayOfMatches, containing all the elements (the characters "group names") that are substrings of B2 and the number of occurrences found in B2.
Finally, output in the C2 cell a sentence built using the ArrayOfMatches data that says something like this:
2 matches for so, 1 match for som and rd
Probably there are other and better approaches to compute the above sentence that is the final result wanted. Maybe I need to use a User Defined Function... but I never made it.
Is there someone that could give help?
May try something like this
Code edited to avoid counting for same substring found multiple times.
Sub test2()
Dim Xstr As String, Ystr As String
Xstr = "somewordsome"
Ystr = "emsomordsowe"
MsgBox Xmatch2(Xstr, Ystr)
End Sub
Function Xmatch2(Xstr As String, Ystr As String) As String
Dim XSubStr As String, YSubStr As String
Dim xLn As Integer, yLn As Integer
Dim XArr As Variant, LnSubStr As Integer
Dim Rslt As String, Cnt As Integer
Dim Xrr() As Variant, Xcnt As Integer, Chk As Boolean
Rslt = "'"
xLn = Len(Xstr)
yLn = Len(Ystr)
For LnSubStr = 2 To xLn 'length of substring
Xcnt = 0
ReDim XArr(1 To 1)
For Y = 1 To xLn
XSubStr = ""
Xcnt = Xcnt + 1
ReDim Preserve XArr(1 To Xcnt)
If Y + LnSubStr - 1 <= xLn Then XSubStr = Mid(Xstr, Y, LnSubStr)
XArr(Xcnt) = XSubStr
Chk = False
For i = 1 To Xcnt - 1
If XArr(i) = XSubStr Then
Chk = True
Exit For
End If
Next
If XSubStr <> "" And Chk = False Then
Cnt = 0
ReDim Preserve XArr(1 To Xcnt)
For Z = 1 To yLn
YSubStr = ""
If Z + LnSubStr - 1 <= yLn Then YSubStr = Mid(Ystr, Z, LnSubStr)
If YSubStr = XSubStr Then Cnt = Cnt + 1
Next
If Cnt > 0 Then Rslt = Rslt & Cnt & " Matches for " & XSubStr & ","
End If
Next
Next
Debug.Print Rslt
Xmatch2 = Rslt
End Function
I have a macro that goes through a list of text, extracts the dollar amounts, increase them by 12%, and replaces the text with the updated dollar amounts.
This what a couple rows of data looks like:
This is the result after I run the macro:
I would need the 72.8 to be 72.80 tho, for example.
Sometimes the result would just have 1 decimal place and sometimes it would have 3. The Round function works fine for me with truncating the result down to 2 decimal places, but doesn't help adding a 0 to keep the number at two decimal places.
I need a way to have fill the second decimal place with a 0 if the result only has 1 decimal place.
This is the macro:
Function onlyDigits(s As String) As String
' Variables needed (remember to use "option explicit"). '
Dim retval As String ' This is the return string. '
Dim i As Integer ' Counter for character position. '
' Initialise return string to empty '
retval = ""
' For every character in input string, copy digits to '
' return string. '
For i = 1 To Len(s)
If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
retval = retval + Mid(s, i, 1)
End If
Next
' Then return the return string. '
onlyDigits = retval
End Function
Sub ChangeDollarAmount()
Dim qtyspec As String
Dim previousDollarIndex As Integer
Dim dollarSignCount As Integer
Dim dollarString As String
Dim originalDollarAmount As String
Dim changedDollarAmount As Double
Dim isANumber As Boolean
previousDollarIndex = 1
' row count
lastrow = ActiveSheet.Range("A1").CurrentRegion.Rows.Count
For Each cell In Range("K2:K" & lastrow)
Debug.Print cell.Formula
previousDollarIndex = 1
qtyspec = cell.Formula
dollarSignCount = (Len(cell.Formula) - Len(Replace(cell.Formula, "$", ""))) / Len("$")
' loop through dollar amounts in text
For i = 1 To dollarSignCount
isANumber = False
previousDollarIndex = InStr(previousDollarIndex + 1, cell.Formula, "$")
originalDollarAmount = Mid(cell.Formula, previousDollarIndex, 8)
Do While isANumber = False
If Not IsNumeric(Right(originalDollarAmount, 1)) Then
originalDollarAmount = Left(originalDollarAmount, Len(originalDollarAmount) - 1)
Else
isANumber = True
End If
Loop
' extract only digits from dollar amount ($345.23 -> 34523)
dollarAmount = onlyDigits(originalDollarAmount)
' add decimal point and increase dollar amount by 12% (34523 -> 345.23 -> 386.66)
changedDollarAmount = Round(CDbl(dollarAmount) * 1.12 * 0.01, 2)
' update the dollar amount in the text
cell.Formula = Replace(cell.Formula, originalDollarAmount, "$" + CStr(changedDollarAmount))
Next i
Next cell
End Sub
changedDollarAmount = CDbl(dollarAmount) * 1.12 * 0.01
cell.Formula = Replace(cell.Formula, originalDollarAmount, Format$(changedDollarAmount, "$0.00"))
For Example,
I'd like a String such as, "This is a Bunch of Words in a sequence of 13 possible 1 words from a Dictionary or BookZZ or Libgen.io 1876" to give me a result of 19 (because "13", "1876" and "1" are numbers and should not be counted).
I created Two Functions which I'm trying to use within this Function I'm asking about:
The first one is the following:
' NthWord prints out the Nth Word of a String of Text in an Excel Cell such
' as A1 or B19.
Function NthWord(ActiveCell As String, N As Integer)
Dim X As String
X = ActiveCell
X = Trim(Mid(Replace(ActiveCell, " ", Application.WorksheetFunction.Rept("
", Len(ActiveCell))), (N - 1) * Len(ActiveCell) + 1, Len(ActiveCell)))
NthWord = X
' In the Excel SpreadSheet:
' Trim (Mid(Substitute(A1, " ", Rept(" ", Len(A1))), (N - 1) * Len(A1)
' + 1, Len(A1)))
End Function
The second one is the following:
'NumberOfWords returns the number of words in a String
Function NumberOfWords(ActiveCell As String)
Dim X As String
X = ActiveCell
Dim i As Integer
i = 0
If Len(Trim(X)) = 0 Then
i = 0
Else:
i = Len(Trim(X)) - Len(Replace(X, " ", "")) + 1
End If
NumberOfWords = i
' In the Excel SpreadSheet
' IF(LEN(TRIM(A1))=0,0,LEN(TRIM(A1))-LEN(SUBSTITUTE(A1," ",""))+1)
End Function
My Attempt at printing the NumberOfNonNumberWords
Function NumberOfNonNumberWords(ActiveCell As String)
Dim X As String
X = ActiveCell
Dim count As Integer
count = 0
Dim i As Integer
If NumberOfWords(X) > 0 Then
For i = 1 To NumberOfWords(X)
If Not (IsNumeric(NthWord(X, i).Value)) Then
count = count + 1
End If
Next i
End If
NumberOfNonNumberWords = count
End Function
However, when I apply this function in the Excel Worksheet, I get an output of
#VALUE!
and I'm not sure why. How do I fix this?
Split the whole string then count non-numeric elements.
function abcWords(str as string) as long
dim i as long, arr as variant
arr = split(str, chr(32))
for i=lbound(arr) to ubound(arr)
abcWords = abcWords - int(not isnumeric(arr(i)))
next i
end function
You could just use SPLIT() to split the text on a space delimiter, then count the non-numeric words:
Function num_words(ByVal text As String)
Dim txt_split
txt_split = Split(text, " ")
Dim total_words As Long
total_words = 0
Dim i As Long
For i = LBound(txt_split) To UBound(txt_split)
If Not IsNumeric(txt_split(i)) Then
total_words = total_words + 1
End If
Next i
num_words = total_words
End Function
Private Sub btnsubmit_Click()
Dim Msg As String
Dim pos1 As Integer
Dim pos2 As Integer
Dim Count As Integer
Dim flag As Integer
Dim telphno
Msg = TextBox1.Value
pos1 = 1
pos2 = 1
flag = 0
Do While pos1 < Len(Msg)
pos1 = InStr(pos1, Msg, "[")
If flag = 0 Then
pos2 = InStr(pos2, Msg, "]")
End If
If pos2 - pos1 < 5 Then
ActiveCell.Value = Mid(Msg, pos1 + 1, pos2 - pos1 - 1)
Count = 0
'Loop through the entire string
For i = pos2 To Len(Msg)
'Check to see if the character is a numeric one
If IsNumeric(Mid(Msg, i, 1)) Then
'Add it to the answer
telphno = telphno + Mid(Msg, i, 1)
Count = Count + 1
'Check to see if we have reached 10 digits
If Count = 10 Then Exit For
Else
telphno = ""
Count = 0
End If
Next i
ActiveCell.Offset(0, 1).Value = telphno
flag = 0
ActiveCell.Offset(1, 0).Select
pos1 = pos2 + 1
pos2 = pos1
telphno = ""
Else
flag = 1
pos1 = pos1 + 1
End If
Loop
End Sub
I am trying to fetch the characters between "[" and "]" in my string but MID function is giving me error. Please help me to fix this problem.
After finding the Characters between "[" and "]" I am looking for nearest 10 digit number. I am taking the string through TextBox (User Input).
And Printing the output on Excel Sheet.
For ex-
[A22]1239163332bcfhds[B23]6453jhddf2784637281ajdnjda[C33]dksamkd1288776655
For the above string. It should give -
A22 1239163332
B23 2784637281
C33 1288776655
Input 2 -
#fiJaeasafiGpaaaaod [A1] # 42, 5532 23156 “63’ 8:355 dedmaa #656 663336, {33538365. sail & as" 53666 wee—9008799499. #dfis.ée.maae06 [A2] S/O éegddad mweefi #dfiE aaseaefi mwaossae We" flees?) all 359% as" fidee, wee—9886557596.
$036903: WI 29365 amass #aoflae mafia] (me) sail was?“ asllmairid’, aha—9945173528. #6066 60333305 2:056. [A4] £06333 messes $6503.91:
33:12:05 mews. 8.133133% a?" aiding as" mamas.
aha-9886444737. [50%. memergfios, [A5] mew 89335365 mamas.
mama. aan wage, as" eagdade, diam—9731742667. eaaiodfiaas. [A6]
ge Wagfiegd mwaofisae mafia) £3966.mafia).sail mg"), as" mairifi, met—9986611558. #8396 30653236 [A7] fleas $839395 fleas# 4138/38, Sgéegd 33905:,623 finaSeag soomrf,ao.&.&.‘w’ea§ss,$3913.29. fideaas 6:312:36,anaemia.all dog as" macaw-36,mom—9448166197.mamas 8985305 [A8192 ageng mews sambaaadefiaefiéfieo.all adswsg, all warm,dam—9945363102.#69535 games [A9]amasssesame#06.ao.&.dsaec56maisafid.aall $33.19 as" mamrid’,wag—9844644272.as.demam] 33mmadésada.Gall 836%62, as" $3668,
wee:—8.839%:ngge [imam meme $36033“flaccid weave.mweafid.all 623; as" maiarid,dam—9481161243.agodaé.8.ao.129330556 agaossae53%;.a?" & as" 5365366,mez—990187114-1.8884232296#2353e65#55.#05.9:330:36 #9033“we ems aim-.1353,swag.all 666663, as" maladdwag—8123565686.gang-56$60506 masses fiaofiaemafifleas mews,swag.all 8665383, as" mdwfid
aha—9845781954.[A10][A11][A12][A13][A14]$63535 3:633:56 [A15]#663 aaaaaefi SawadJaeawe: aa£eas€ mews,{3368366.sail 6.9% all 0369966,dam—9945707587eaoadfi mesmereaa’cfiwsl6:36:38 agaoisaefiasfiewéédaall 303:3, as" 03653613,dam-9900436152.$830335eiedafi $885366 Qawaeeiapflsaecss,asasdne.aall wipe, as" 53566,Elma—9448218974.$69836 memergfios [A18]# 167,“&oa5555”15’ 2:336, 63:: #55,deg-353255 9:355 acme-3%,massarifi.aall 3.3.333 as” nae-36386,WEE—9342495800.#%§ mewaergfics [A19]# 794/8 oomfieo.modes mews,65366666.all 6333 as" mwwfi'fi,dam—9945434802.$830535 Meme®$cs [A20]#30335 masses Mathewsmandaoddwsg.sail fine]; as" 53538363,met-9980170633.#506 memergaos903361103: $358365 Saaawsae3536333.Ball 36335623, as" $368966,Wei-9972675782[A17] [A21]
Expected Ouput -
A1 9008799499
A2 9886557596
A4 9886444737
A5 9731742667
A6 9986611558
A7 9448166197
and so on till
A20 9980170633
Your code is "screaming" for the use of RegEx , see code below (explantion inside code comments).
Sub btnsubmit Code
Option Explicit
Private Sub btnsubmit_Click()
Dim Msg As String
Dim pos1 As Integer
Dim pos2 As Integer
Dim posDelta As Integer
Dim telphno
Dim i As Integer
' added these 2 variables
Dim insideBrackets As String
Dim telphnoPos As Integer
TextBox1.Value = Sheets("sheet2").Range("H5").Value
Msg = TextBox1.Value
pos1 = 1
pos2 = 1
' loop while Msg still no emptied out
Do While (Msg) <> ""
TextBox1.Value = Msg
Debug.Print Len(Msg)
pos1 = InStr(Msg, "[")
pos2 = InStr(Msg, "]")
' find number of characters between "[" and "]"
posDelta = pos2 - pos1
Select Case posDelta
Case Is < 0 ' only "]" found , and no "["
Msg = Right(Msg, Len(Msg) - pos2)
Case 3, 4 ' could be A# , or A##
insideBrackets = Mid(Msg, pos1 + 1, pos2 - pos1 - 1)
telphno = "" ' reset value
telphnoPos = 0
Msg = Right(Msg, Len(Msg) - pos2)
' call function with Regex to find first 10 digits in string
telphno = GetFirstTenDigits(Msg)
' find position of first 10 digits inside the string
If telphno <> "" Then telphnoPos = InStr(Msg, telphno)
' successfult 10-digit resulted from RegEx
If telphnoPos > 0 Then
ActiveCell.Value = insideBrackets
ActiveCell.Offset(0, 1).Value = telphno
' remove characters from string that were extracted to the cells
Msg = Right(Msg, Len(Msg) - (telphnoPos + 10 - 1))
insideBrackets = "" ' reset value
' advance 1 row
ActiveCell.Offset(1, 0).Select
Else
Msg = "" ' no 10 digits ccurrences left
End If
Case Is > 4
Msg = Right(Msg, Len(Msg) - pos1)
End Select
Loop
End Sub
***Function GetFirstTenDigits* Code** (uses the `Regex` object)
Function GetFirstTenDigits(byMixedString As String) As String
' this function uses the RegEx to find all numeric characters insde the passed string
' then it searches for the first occorunce that the number of digits = 10 ,
' and returns it to the calling Sub
Dim RegEx As Object, Matches As Object, Match As Object
Set RegEx = CreateObject("vbscript.regexp")
With RegEx
.MultiLine = False
.Global = True
.IgnoreCase = True
.Pattern = "(\d+)" ' Match any set of digits
End With
Set Matches = RegEx.Execute(byMixedString)
For Each Match In Matches
If Len(Match) = 10 Then
' return the first match of 10 digits
GetFirstTenDigits = Match
Exit Function
End If
Next Match
End Function
Your problem is occurring because you are not exiting the loop when there are no more [...] pairs remaining.
If you change
pos1 = InStr(pos1, Msg, "[")
to have the following code immediately after it, I think your problems will go away:
If pos1 = 0 Then
Exit Do
End If
Your calculation of pos2 should also be changed from
pos2 = InStr(pos2, Msg, "]")
to
pos2 = InStr(pos1, Msg, "]")
This will ensure that you are picking up the location of the first ] after the current [.
After those two changes, your code correctly processes both of the examples now given in your question ... except for writing out records for the trailing [A17] and [A21] in the second example - I'm not sure whether you really want them ignored, or whether your second example was truncated partway through the source data.