I got quite a challenging assignment to " introduce " us (as a mathematics class) to VBA. Don't ask me why.
I've asked this question a few hours ago, but I hadn't quite described the (weird) restrictions that are part of the assignment.
They want us to write code that reverses the sentence "VBA is amazing" word by word. So the outcome must be: "ABV si gnizama". And now comes the challenging part; The only functions that are allowed are Len and Mid
The sentence "VBA is amazing" may be followed by a space to make it easier..
I was thinking of a while-loop where I can find the first word in the sentence:
Do While Mid(Sentence, i, 1) <> " "
i = i+1
Loop
That should give the position of the first space and thereby the length (i-1) of the first word.
And then I would maybe use a nested for-loop to assign Mid(Sentence, x, 1) = Mid(Sentence,z,1) with x from 1 to i-1 and z from i-1 to 1, but I'm too new to VBA to know how.
I've got code that puts out: "gnizama si ABV", but that's not what this is about.
If you must use only Len and Mid then this will do it.
Sub ReverseStringByWord()
Dim i As Long
Dim newstr As String
Dim wordbreak As Long
Dim mystr As String
mystr = "VBA is amazing"
wordbreak = 1
For i = 1 To Len(mystr)
If Mid(mystr, i, 1) = " " Then
wordbreak = i
newstr = newstr & Mid(mystr, i, 1)
Else
If wordbreak > 1 Then
newstr = Mid(newstr, 1, wordbreak) & Mid(mystr, i, 1) & Mid(newstr, wordbreak + 1, Len(newstr))
Else
newstr = Mid(mystr, i, 1) & newstr
End If
End If
Next i
Debug.Print mystr, newstr
End Sub
Related
This has probably been asked a million times in different variations but I can't find an answer that fits.
I have a string that contains up to 4 MUT IDs ("MUT" followed by 5 numbers, eg MUT00761). If there is more than one ID, they are separated by a space. In some occasion, there will also be a * between two IDs (eg MUT00761 * MUT00684). The * is associated with the MUT ID on its left. I need to remove all those MUT IDs (and their *),if any.
EG, "MUT00111 MUT00222 * MUT00333 MUT00444 *" needs to become "MUT00111 MUT00333".
Worksheet Formula
=IFERROR(TRIM(SUBSTITUTE(A1,MID(A1,FIND("*",A1)-9,10),"")),A1)
VBA UDF
Function MUT(S as String) as String
On Error Resume Next
MUT = Trim(Replace(S, Mid(S, InStr(1, S, "*") - 9, 10), vbNullString))
If CBool(Err.Number) Then MUT = S
End Sub
1) get the position of 1st MUT with something instr(1,entireText, "MUT"[, …])
2) cut out MUT plus x characters or until the next "," with
3) do again until no MUT is found
Use the Microsoft VBScript Regular Expresions 5.5 library to replace instances of 'MUT *' with vbNullString.
OR
If you don;t grok Regex a simple function like
Public Function StripStarredIds(ByVal IdString As String) As String
Do While InStr(IdString, "*")
IdString = Replace(IdString, Mid$(IdString, InStr(IdString, "*") - 10, 10), vbNullString)
Loop
StripStarredIds = IdString
End Function
I would use a custom function to do this. It may be a bit clunky but this should work:
Function StripText(ByVal fullText As String) As String
newText = ""
lastIndex = 1
curIndex = InStr(1, fullText, " *")
If curIndex = 0 Then '// if no instances of " *" are found then just copy the full text
newText = fullText
Else
Do While (curIndex > 0) '// do until no instances of " *" are found
newText = newText & Mid(fullText, lastIndex, curIndex - lastIndex - 9)
lastIndex = curIndex + 2
curIndex = InStr(lastIndex + 1, fullText, " *")
Loop
End If
StripText = newText
End Function
you could use Split() function like this:
Function GiveItAName(s As String) As String
Dim res As String
Dim v As Variant, w As Variant
Dim i As Long, j As Long
v = Split(s, " *")
For j = 0 To UBound(v) - 1
w = Split(v(j), " ")
For i = 0 To UBound(w) - 1
res = res & w(i) & " "
Next
Next
GiveItAName = WorksheetFunction.Trim(res & v(j))
End Function
what will i do to make it accept my equation and able to make all inserted word first letter capital? i f5 this equation and it show some yellow errors if i input a word.
i tried if i = 0 then
so it only shows first word first letter capital the rest isnt.
https://m.facebook.com/story.php?story_fbid=209840356412510&id=100021596419779&refid=17&tn=%2AW-R&_rdr
You didn't post your code on your post so i don't know what you tried but this code works perfectly in order to achieve your goal.
Dim textBoxString As String = TextBox1.Text.Trim
'Create a string array with every words'
Dim words() As String = textBoxString.Split(" ")
'labelString is our final result'
Dim labelString As String = ""
'cycle throught every word'
For i = 0 To textBoxString.Length - 1
Try
'substring(0,1) takes only the first char of the word'
words(i) = words(i).ToUpper().Substring(0, 1) & words(i).Substring(1, words(i).Length - 1)
labelString = labelString & words(i) & " "
Catch ex As Exception
Err.Clear()
Exit For
End Try
Next
Label1.Text = labelString
Little explanation of my code
words(i).ToUpper.Substring(0,1)
it takes only the first char of every word throught the cycle.
words(i).Substring(1, words(i).Lenght -1)
it takes the entire word without the first char
labelString = labelString & words(i) & " "
it concatenates every words back together.
Let's say I have the following string within a cell:
E. Stark, T. Lannister, A. Martell, P Baelish, B. Dondarrion, and J. Mormont. Increased levels of nudity across Westeros contributes to its sporadic seasonal climate. Nat. Proc. Aca. Sci. (2011) 3: 142-149.
And I want to extract only the title from this. The approach I am considering is to write a script that says "Pull text from this string, but only if it is more than 50 characters long." This way it only returns the title, and not stuff like " Stark, T" and " Martell, P". The code I have so far is:
Sub TitleTest()
Dim txt As String
Dim Output As String
Dim i As Integer
Dim rng As Range
Dim j As Integer
Dim k As Integer
j = 5
Set rng = Range("A" & j) 'text is in cell A5
txt = rng.Value 'txt is string
i = 1
While j <= 10 'there are five references between A5 and A10
k = InStr(i, txt, ".") - InStr(i, txt, ". ") + 1 'k is supposed to be the length of the string returned, but I can't differenciate one "." from the other.
Output = Mid(txt, InStr(i, txt, "."), k)
If Len(Output) < 100 Then
i = i + 1
ElseIf Len(Output) > 10 Then
Output = Mid(txt, InStr(i, txt, "."), InStr(i, txt, ". "))
Range("B5") = Output
j = j + 1
End If
Wend
End Sub
Of course, this would work well if it wasn't two "." I was trying to full information from. Is there a way to write the InStr function in such a way that it won't find the same character twice? Am I going about this in the wrong way?
Thanks in advance,
EDIT: Another approach that might work (if possible), is if I could have one character be " any lower case letter." and ".". Would even this be possible? I can't find any example of how this could be achieved...
Here you go, it works exactly as you wish. Judging from your code I am sure that you can adapt it for your needs quite quickly:
Option Explicit
Sub ExtractTextSub()
Debug.Print ExtractText("E. Stark, T. Lannister, A. Martell, P Baelish, B. Dondarrion, and J. Mormont. Increased levels of nudity across Westeros contributes to its sporadic seasonal climate. Nat. Proc. Aca. Sci. (2011) 3: 142-149.")
End Sub
Public Function ExtractText(str_text As String) As String
Dim arr As Variant
Dim l_counter As Long
arr = Split(str_text, ".")
For l_counter = LBound(arr) To UBound(arr)
If Len(arr(l_counter)) > 50 Then
ExtractText = arr(l_counter)
End If
Next l_counter
End Function
Edit: 5 votes in no time made me improve my code a bit :) This would return the longest string, without thinking of the 50 chars. Furthermore, on Error handlaer and a constant for the point. Plus adding a point to the end of the extract.
Option Explicit
Public Const STR_POINT = "."
Sub ExtractTextSub()
Debug.Print ExtractText("E. Stark, T. Lannister, A. Martell, P Baelish, B. Dondarrion, and J. Mormont. Increased levels of nudity across Westeros contributes to its sporadic seasonal climate. Nat. Proc. Aca. Sci. (2011) 3: 142-149.")
End Sub
Public Function ExtractText(str_text As String) As String
On Error GoTo ExtractText_Error
Dim arr As Variant
Dim l_counter As Long
Dim str_longest As String
arr = Split(str_text, STR_POINT)
For l_counter = LBound(arr) To UBound(arr)
If Len(arr(l_counter)) > Len(ExtractText) Then
ExtractText = arr(l_counter)
End If
Next l_counter
ExtractText = ExtractText & STR_POINT
On Error GoTo 0
Exit Function
ExtractText_Error:
MsgBox "Error " & Err.Number & Err.Description
End Function
For example, I have this string that reads "IRS150Sup2500Vup". It could also be "IRS250Sdown1250Vdown".
In my previous qn, I asked how to find a number between 2 characters. Now, I need to find the word up or down after the second S now. Since it appears between the character S and the number, how do I do it?
My code looks like this:
Dim pos, pos1,pos2 strString As String
pos = InStr(1, objFile.Name, "S") + 1
pos1 = InStr(pos, objFile.Name, "S")
pos2 = InStr(pos1, objFile.Name, ?)
pos1 returns the index of the second S. I am not sure what to place in ?
Using Regex.
Note: you need a reference to MS VBScripts Regular Expression library.
Dim r As VBScript_RegExp_55.RegExp
Dim sPattern As String, myString As String
Dim mc As VBScript_RegExp_55.MatchCollection, m As VBScript_RegExp_55.Match
myString = "IRS150Sup2500Vup"
sPattern = "\w?up+" 'searches for Sup, Vup, etc.
Set r = New VBScript_RegExp_55.RegExp
r.Pattern = sPattern
Set mc = r.Execute(myString)
For Each m In mc ' Iterate Matches collection.
MsgBox "word: '" & m.Value & "' founded at: " & m.FirstIndex & " length: " & m.Length
Next
For further information, please see:
How To Use Regular Expressions in Microsoft Visual Basic 6.0
Find and replace text by using regular expressions (Advanced)
I have a highlighting algorithm that takes a string and adds highlighting codes around matches in it. The problem I am having is with words like "Find tæst" as the string to be searched and "taest" as the string to find. Since the length of the search string doesn't match the length of the match, I can't accurately find the end of the match. IndexOf in my case is showing me the match but since the combined æ is counted as one character, it is throwing off my detection of the end of the match. I don't think IndexOf will work for me here. Something that returns the index of the match and the length of the match would work. But I don't know what else to use.
' cycle through search words and replace them in the text
For intWord = LBound(m_arrSearchWords) To UBound(m_arrSearchWords)
If m_arrSearchWords(intWord).Length > 0 Then
' replace instances of the word with the word surrounded by bold codes
' find starting position
intPos = strText.IndexOf(m_arrSearchWords(intWord), System.StringComparison.CurrentCultureIgnoreCase)
Do While intPos <> -1
strText = strText.Substring(0, (intPos - 1) - 0 + 1) & cstrHighlightCodeOn & strText.Substring(intPos, m_arrSearchWords(intWord).Length) & cstrHighlightCodeOff & strText.Substring(intPos + m_arrSearchWords(intWord).Length)
intPos = strText.IndexOf(m_arrSearchWords(intWord), intPos + m_arrSearchWords(intWord).Length + cstrHighlightCodeOn.Length + cstrHighlightCodeOff.Length, System.StringComparison.CurrentCultureIgnoreCase)
Loop
End If
Next intWord
The Substring method is failing as the length is beyond the end of the string. I put a fix in for strings that end with the search term (not shown above). But longer strings will be highlighted incorrectly and I need to fix those.
While it would be nice of IndexOf to return the match length, it turns out you can just do the comparison yourself to figure it out. I just do a secondary comparison with a length to find the largest match. I start at the length of the searched for word, which should be the largest. And then work my way backwards to find the length. Once I've found the length I use that. If I don't find it, I work my way up in length. This works if the string I'm searching for is larger or if it is smaller. It means in the normal case at least one extra comparison and in the worst case an additional number based on the length of the search word. Maybe if I had the implementation for IndexOf, I could improve it. But at least this works.
' cycle through search words and replace them in the text
For intWord = LBound(m_arrSearchWords) To UBound(m_arrSearchWords)
If m_arrSearchWords(intWord).Length > 0 Then
' find starting position
intPos = strText.IndexOf(m_arrSearchWords(intWord), System.StringComparison.CurrentCultureIgnoreCase)
Do While intPos <> -1
intOrigLength = m_arrSearchWords(intWord).Length
' if there isn't enough of the text left to add the search word length to
If strText.Length < ((intPos + intOrigLength - 1) - 0 + 1) Then
' use shorter length
intOrigLength = ((strText.Length - 1) - intPos + 1)
End If
' find largest match
For intLength = intOrigLength To 1 Step -1
If m_arrSearchWords(intWord).Equals(strText.Substring(intPos, intLength), StringComparison.CurrentCultureIgnoreCase) Then
' if match found, highlight it
strText = strText.Substring(0, (intPos - 1) - 0 + 1) & cstrHighlightCodeOn & strText.Substring(intPos, intLength) & cstrHighlightCodeOff & strText.Substring(intPos + intLength)
' find next
intPos = strText.IndexOf(m_arrSearchWords(intWord), intPos + intLength + cstrHighlightCodeOn.Length + cstrHighlightCodeOff.Length, System.StringComparison.CurrentCultureIgnoreCase)
' exit search for largest match
Exit For
End If
Next
' if we didn't find it by searching smaller - search larger
If intLength = 0 Then
For intLength = intOrigLength + 1 To ((strText.Length - 1) - intPos + 1)
If m_arrSearchWords(intWord).Equals(strText.Substring(intPos, intLength), StringComparison.CurrentCultureIgnoreCase) Then
' if match found, highlight it
strText = strText.Substring(0, (intPos - 1) - 0 + 1) & cstrHighlightCodeOn & strText.Substring(intPos, intLength) & cstrHighlightCodeOff & strText.Substring(intPos + intLength)
' find next
intPos = strText.IndexOf(m_arrSearchWords(intWord), intPos + intLength + cstrHighlightCodeOn.Length + cstrHighlightCodeOff.Length, System.StringComparison.CurrentCultureIgnoreCase)
' exit search for largest match
Exit For
End If
Next
End If
Loop
End If
Next intWord
If I understand correctly, you are looking for a function that returns the "matched-string" - in other words, when you are looking for s1 inside s2, then you want to know exactly what part of s2 was matched (index of first and last character matched). This allows you to highlight the match, and doesn't modify the string (upper/lower case, ligature, etc).
I don't have VB.net, and unfortunately VBA doesn't have exactly the same search functionality as VB.net - so please understand that the following code correctly identifies the beginning and end of a match, but it's only tested with upper/lower case matching. I hope this helps you solve the problem.
Option Compare Text
Option Explicit
Function startEndIndex(bigString, smallString)
' function that returns start, end index
' of the match
' it keeps shortening the bigString until no match is found
' this is how it takes care of mismatches in number of characters
' because of a match between "similar" strings
Dim i1, i2
Dim shorterString
i2 = 0
' first see if there is a match at all:
i1 = InStr(1, bigString, smallString, vbTextCompare)
If i1 > 0 Then
' largest value that i2 can have is end of string:
i2 = Len(bigString)
' can make it shorter - but no shorter than twice the length of the search string
If i2 > i1 + 2 * Len(smallString) Then i2 = i1 + 2 * Len(smallString)
shorterString = Mid(bigString, i1, i2 - i1)
' keep making the string shorter until there is no match:
While InStr(1, shorterString, smallString, vbTextCompare) > 0
i2 = i2 - 1
shorterString = Mid(bigString, i1, i2 - i1)
Wend
End If
' return the values as an array:
startEndIndex = Array(i1, endOfString)
End Function
Sub test()
' a simple test routine to see that things work:
Dim a
Dim longString: longString = "This is a very long TaesT of a complicated string"
a = startEndIndex(longString, "very long taest")
If a(0) = 0 And a(1) = 0 Then
MsgBox "no match found"
Else
Dim highlightString As String
highlightString = Left(longString, a(0) - 1) & "*" & Mid(longString, a(0), a(1) - a(0) + 1) & _
"*" & Mid(longString, a(1) + 1)
MsgBox "start at " & a(0) & " and end at " & a(1) & vbCrLf & _
"string matched is '" & Mid(longString, a(0), a(1) - a(0) + 1) & "'" & vbCrLf & _
"with highlighting: " & highlightString
End If
End Sub