So I'm writing a piece of code that has the goal of taking, for example, coding #codez code #coderino and turning it into coding #CODEZ code #CODERINO.
It works just fine if I only have one # in the phrase, eg. coding #codez code turns into coding #CODEZ code.
However, if I have more than one # in the phrase, such as in the first example, it ignores the loop and makes nothing uppercase, or simply breaks.
Here's the piece of code that I'm having an issue with:
Do Until CurrentPositionOfAtSymbol = -1
CurrentPositionOfAtSymbol = StartingTweet.IndexOf("#", CurrentPositionOfSpace + 1)
CurrentPositionOfSpace = StartingTweet.IndexOf(" ", CurrentPositionOfAtSymbol)
TempName = StartingTweet.Substring(CurrentPositionOfAtSymbol + 1, CurrentPositionOfSpace - CurrentPositionOfAtSymbol - 1)
TempNameUppercase = TempName.ToUpper
StartingTweet = StartingTweet.Remove(CurrentPositionOfAtSymbol + 1, CurrentPositionOfSpace - CurrentPositionOfAtSymbol - 1)
StartingTweet = StartingTweet.Insert(CurrentPositionOfAtSymbol + 1, TempNameUppercase)
CurrentPositionOfAtSymbol = StartingTweet.IndexOf("#", CurrentPositionOfSpace + 1)
Loop
What I would do is break it up by spaces and then check each word, if it starts with # uppercase it. Then put it all back together:
Function FixString(item As String) As String
Dim parts As String()
parts = item.Split(" ")
For index = 0 To parts.Length - 1
If (parts(index).StartsWith("#")) Then
parts(index) = parts(index).ToUpper()
End If
Next
Return String.Join(" ", parts)
End Function
Related
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 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
Given a string containing:
property myprop1="test" myprop2="testing again" myprop3="another test"
What is the easiest way to get into a string array:
property
myprop1="test"
myprop2="testing again"
myprop3="another test"
Splitting into a 2 dimension array would be even better:
property
myprop1 test
myprop2 testing again
myprop3 another test
My original plan was to run the split function with a space delimiter on the string. This works if there are no spaces embedded in the value portion of the name-value pair, which (of course) do contain spaces.
Some conditions:
This code needs to execute in Excel 2010 VBA. I don't want to have to add third-party references or a bunch of toolkits. I'm not looking for elegant or IEEE examples. I need maintainable and understandable production code.
Thanks in advance for any and all assistance!
EDIT: The number of 'mypropX' are variable; there may be less or more than three.
EDIT2: I've been informed of another 'difference'. :) Turns out the value of a myprop might not be delimited by double quotes; in that case it will be a single alphanumeric string with no interior spaces.
Try this
Sub Test()
Dim strVar, Arr1, Arr2()
strVar = "property myprop1=""test"" myprop2=""testing again"" myprop3=""another test"""
Arr1 = Split(Mid(strVar, InStr(1, strVar, " ") + 1), """ ")
ReDim Arr2(UBound(Arr1) + 1)
Arr2(0) = Mid(strVar, 1, InStr(1, strVar, " ")) 'store the first string, i.e. property
'store the data with double quotes
For i = 0 To UBound(Arr1) - 1
Arr2(i + 1) = Arr1(i) & """"
Next
'store the last string
Arr2(i + 1) = Arr1(i)
For i = 0 To UBound(Arr2)
MsgBox Arr2(i)
Next
End Sub
If you replace('="','=') then you can do a split on '" ' and this should give you:
property
myprop1=test
myprop2=testing again
myprop3=another test
This assumes that there are no " inside the quotes (which would make a mess of most attempts to parse anyway).
Then you can split the items in this array on '=' to get into a 2 element array. To account for possible = within values set the Limit parameter on Split() to 2.
Edit:
I'm feeling generous - here's some code - add your own error handling!
Public Sub ParseNVPs(ByVal str As String, ByRef ReturnArray() as String)
Dim SplitArray() As String
Dim LineArray() As String
Dim i As Integer
str = Replace(str, "=""", "=")
SplitArray = Split(str, """ ")
ReDim ReturnArray(UBound(SplitArray), 1)
For i = 0 To UBound(SplitArray)
LineArray = Split(SplitArray(i), "=", 2)
ReturnArray(i, 0) = LineArray(0)
ReturnArray(i, 1) = LineArray(1)
Next i
End Sub
Here's what I came up with. It's not elegant but it gets the job done. Thanks for the input folks, it was very helpful.
'split name value pairs into array
strWorkString = schematicLines(lngValuePosition)
lngStartPosition = 1
lngEndPosition = 1
fStartQuote = False
f1stWordDone = False
ReDim strWorkArray(0) As String
For lngLoopCounter = 1 To Len(strWorkString) - 1
strCurrentCharacter = Mid(strWorkString, lngLoopCounter, 1)
Select Case True
Case (strCurrentCharacter = " " And Not fStartQuote) 'space and we aren't in a value
If (f1stWordDone) Then
ReDim Preserve strWorkArray(UBound(strWorkArray) + 1) As String
End If
lngEndPosition = lngLoopCounter
strWorkArray(UBound(strWorkArray)) = Trim(Mid(strWorkString, lngStartPosition, lngEndPosition - lngStartPosition))
lngStartPosition = lngEndPosition + 1
lngEndPosition = lngStartPosition
f1stWordDone = True
Case strCurrentCharacter = Chr$(34) 'double quote
If fStartQuote Then 'in a value
'store the nvp
lngEndPosition = lngLoopCounter
ReDim Preserve strWorkArray(UBound(strWorkArray) + 1) As String
strWorkArray(UBound(strWorkArray)) = Trim(Mid(strWorkString, lngStartPosition, lngEndPosition - lngStartPosition + 1))
lngLoopCounter = lngLoopCounter + 1 'skip the space
lngStartPosition = lngLoopCounter
lngEndPosition = lngStartPosition
fStartQuote = False
Else
fStartQuote = True
End If
End Select
Next lngLoopCounter
' get the last nvp
ReDim Preserve strWorkArray(UBound(strWorkArray) + 1) As String
strWorkArray(UBound(strWorkArray)) = Mid(strWorkString, lngStartPosition, lngLoopCounter - lngStartPosition + 1)
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
The following code works, to simply get each line as a line in the listbox.
Reader = IO.File.OpenText(textlocation)
Dim bookmarks() As String = Reader.ReadToEnd.Split(vbNewLine)
Dim i As Integer = 0
Do Until i = bookmarks.Length
lstFavorites.Items.Add(bookmarks(i))
i += 1
Loop
But I don't want every line to go into the text box. I only want the lines that contain the text "Bookmark" to go into the listbox. What can I do to achieve this? I've tried everything I can think of.
Heres some code I tried, I can't see the problem in it, but it seems to just crash my program.
Do Until i = bookmarks.Length
If bookmarks(i).Contains("at") Then
If radBookmarks.Checked Then
If bookmarks(i).Contains("Bookmark") Then
Original = bookmarks(i)
BeginningOfDemoName = Original.Substring(Original.LastIndexOf("(") + 2)
TickWithParenthesis = BeginningOfDemoName.Substring(BeginningOfDemoName.IndexOf(Chr(34)) + 4)
Tick = TickWithParenthesis.Split(" ")(1).Split(")")(0)
DemoName = BeginningOfDemoName.Split(Chr(34))(0)
ToList = DemoName + " at " + Tick
lstFavorites.Items.Add(ToList)
i += 1
Else
i += 1
End If
ElseIf radEverything.Checked Then
Original = bookmarks(i)
BeginningOfDemoName = Original.Substring(Original.LastIndexOf("(") + 2)
TickWithParenthesis = BeginningOfDemoName.Substring(BeginningOfDemoName.IndexOf(Chr(34)) + 4)
Tick = TickWithParenthesis.Split(" ")(1).Split(")")(0)
DemoName = BeginningOfDemoName.Split(Chr(34))(0)
ToList = DemoName + " at " + Tick
lstFavorites.Items.Add(ToList)
i += 1
End If
End If
Loop
Try to change this line
If bookmarks(i).Contains("Bookmark") Then
to
If bookmarks(i).IndexOf("Bookmark",
StringComparison.CurrentCultureIgnoreCase) >= 0 Then
Contains do a case sensitive comparison and your input string contains a lower case 'bookmark'