Ive got some items of text in Excel and id like to capitalise the first letter of each word. However, a lot of text contains the phrase 'IT' and using current capitalisation methods (PROPER) it changes this to 'It'. Is there a way to only capitalise the first letter of each word without DE capitalising the other letters in each word?
Here is a VBA way, add it to a module & =PrefixCaps("A1")
Public Function PrefixCaps(value As String) As String
Dim Words() As String: Words = Split(value, " ")
Dim i As Long
For i = 0 To UBound(Words)
Mid$(Words(i), 1, 1) = UCase$(Mid$(Words(i), 1, 1))
Next
PrefixCaps = Join(Words, " ")
End Function
Used the website http://www.textfixer.com/tools/capitalize-sentences.php and pasted it all in instead
That was all a bit complicated, but I did find if your spreadsheet is pretty simple, you can copy and paste it into word and use it's editing features and then copy and paste that back in to Excel. Worked quite well for me.
Fixes double spaces in the text:
Public Function PrefixCaps(value As String) As String
Dim Words() As String: Words = Split(value, " ")
Dim i As Long
For i = 0 To UBound(Words)
If Len(Words(i)) > 0 Then
Mid$(Words(i), 1, 1) = UCase$(Mid$(Words(i), 1, 1))
End If
Next
PrefixCaps = Join(Words, " ")
End Function`
Related
I need help with my code that displays an input box and the user inputs a name then the code splits the names and counts the names displaying the following:
Sub ParseName()
Dim Name As String
Dim Count As Integer
Dim Cell As Object
Dim n As Integer
Count = 0
Name = InputBox("Enter First Name, Middle Name, and Last Name")
If Name = "" Then
For Each Cell In Selection
n = InStr(1, Cell.Value, Name)
While n <> 0
Count = Count + 1
n = InStr(n + 1, Cell.Value, Name)
Next Cell
MsgBox Count & " Occurrences of " & Name
End If
End Sub
Absolutely. You could split the names, but it probably wouldn't help. VBA's split doesn't allow you to split on single characters, AFAIK, as other languages might if you split them a specific delimiter. So you could just loop through the characters using MID to see if each letter is a space or not.
There is a way without any splitting or looping. You can just replace the space and get the length of the what's left.
Len(Replace(Name, " ", ""))
where REPLACE just replaces one string with another, in this case replacing all the spaces with nothing, and LEN just counts the characters in a string.
Here's your code rewritten to use this method, with the unnecessary code and variables removed. I would also change the Name variable, since I believe that is a reserved word in VBA. It will let you do it, but you're potentially impacting some existing behavior. For this particular purpose, using a standalone function to get the character count is someh
Sub ParseName()
Dim fullName As String, charCount As Integer
fullName = InputBox("Enter First Name, Middle Name, and Last Name")
If fullName <> "" Then
charCount = Len(Replace(fullName, " ", ""))
MsgBox fullName & " has " & charCount & " characters"
End If
End Sub
Bear in mind, however, that there are plenty of other character codes you might not want to count. Tabs, new lines, any of a number of whitespace characters. Non-character symbols. Things of that nature.
Also, this code does not check that the string even contains letters, or that the user input has three names, or that it is in the format First Middle Last.
I want to replace a substring (substring_a) with another substring (substring_b) within a string by specifying the position and length of substring_a.
I'm trying to use the Mid function, but it doesn't seem to work unless substring_b is equal to or longer than substring_a
Here is my code:
Sub Test_Mid()
Dim starting_text As String
Dim replacement_text As String
starting_text = "Long Starting Text"
replacement_text = "End"
Mid(starting_text, 6, 8) = replacement_text
MsgBox (starting_text)
End Sub
I want the code to return "Long End Text", but instead it returns "Long Endrting Text".
How do I fix this?
Note: The above is an illustrative example. I can't use the Replace function directly with the replacement_text because in my actual macro, replacement_text is variable.
You are making a simple thing overly complex. All that is needed is a simple replace.
starting_text = Replace(starting_text, "Starting", "End")
To replace just the 1st occurrence, use this:
starting_text = Replace(starting_text, "Starting", "End", 1, 1)
Or if it's just one occurrence, starting at a specific location, use this:
starting_text = Replace(starting_text, "Starting", "End", Instr(starting_text, "Starting"), 1)
Or if it's just one occurrence, starting at a specific location, and you dont want it to be case sensitive, use this:
starting_text = Replace(starting_text, "Starting", "End", Instr(starting_text, "Starting", vbTextCompare), 1, vbTextCompare)
VBA Replace Function
Below is my solution:
Sub Test_Mid()
Dim starting_text As String
Dim replacement_text As String
Dim replaced_text As String
starting_text = "Long Starting Text"
replacement_text = "End"
replaced_text = Mid(starting_text, 6, 8)
starting_text = Replace(starting_text, replaced_text, replacement_text)
MsgBox (starting_text)
End Sub
Note: For the example code here, #brax's solution is more efficient, but this code above shows how to replace text at a specific position (which is what I need for my actual use case).
Replacing a string in string in VBA is an easy taks, if Replace() is used.
Anyway, if Replace() is to be omitted, then it becomes more interesting. Theoretically, the string could be splitted always into 3 parts:
First Part - String To Replace - Last Part
Even when the FirstPart or/and the LastPart are with length 0, the division is to be made. Then, removing StringToReplace from the string completely and in its position, write the new string. The position is determinted with IsStr. It could be used as a function, using error handlers to return the initial expression, if the find is not part of the string:
Function Replace2(expression As String, find As String, replace As String) As String
On Error GoTo replace2_Error
Replace2 = expression
Dim position As Long: position = InStr(1, expression, find)
Replace2 = Left(expression, position - 1)
Replace2 = Replace2 & Mid(expression, position + Len(find))
Replace2 = Left(Replace2, position - 1) & _
replace & _
Right(Replace2, Len(Replace2) - position + 1)
Exit Function
replace2_Error:
Replace2 = expression
End Function
And the tests of the function:
Sub TestMe()
Debug.Print Replace2("1", "", "")
Debug.Print Replace2("1", "", "2")
Debug.Print Replace2("", "3", "")
Debug.Print Replace2("32", "a", "")
Debug.Print Replace2("My Very Interesting Long Starting Text", "Starting", "Ending")
Debug.Print Replace2("My Very Interesting Long Text Starting", "Starting", "Ending")
Debug.Print Replace2("Starting My Very Interesting Long Text", "Starting", "Ending")
End Sub
I'm looking for a macro (preferably a function) that would take cell contents, split it into separate words, compare them to one another and remove the shorter words.
Here's an image of what I want the output to look like (I need the words that are crossed out removed):
I tried to write a macro myself, but it doesn't work 100% properly because it's not taking the last words and sometimes removes what shouldn't be removed. Also, I have to do this on around 50k cells, so a macro takes a lot of time to run, that's why I'd prefer it to be a function. I guess I shouldn't use the replace function, but I couldn't make anything else work.
Sub clean_words_containing_eachother()
Dim sht1 As Worksheet
Dim LastRow As Long
Dim Cell As Range
Dim cell_value As String
Dim word, word2 As Variant
Set sht1 = ActiveSheet
col = InputBox("Which column do you want to clear?")
LastRow = sht1.Cells(sht1.Rows.Count, col).End(xlUp).Row
Let to_clean = col & "2:" & col & LastRow
For i = 2 To LastRow
For Each Cell In sht1.Range(to_clean)
cell_value = Cell.Value
cell_split = Split(cell_value, " ")
For Each word In cell_split
For Each word2 In cell_split
If word <> word2 Then
If InStr(word2, word) > 0 Then
If Len(word) < Len(word2) Then
word = word & " "
Cell = Replace(Cell, word, " ")
ElseIf Len(word) > Len(word2) Then
word2 = word2 & " "
Cell = Replace(Cell, word2, " ")
End If
End If
End If
Next word2
Next word
Next Cell
Next i
End Sub
Assuming that the retention of the third word in your first example is an error, since books is contained later on in notebooks:
5003886 book books bound case casebound not notebook notebooks office oxford sign signature
and also assuming that you would want to remove duplicate identical words, even if they are not contained subsequently in another word, then we can use a Regular Expression.
The regex will:
Capture each word
look-ahead to see if that word exists later on in the string
if it does, remove it
Since VBA regexes cannot also look-behind, we work-around this limitation by running the regex a second time on the reversed string.
Then remove the extra spaces and we are done.
Option Explicit
Function cleanWords(S As String) As String
Dim RE As Object, MC As Object, M As Object
Dim sTemp As String
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = True
.Pattern = "\b(\w+)\b(?=.*\1)"
.ignorecase = True
'replace looking forward
sTemp = .Replace(S, "")
' check in reverse
sTemp = .Replace(StrReverse(sTemp), "")
'return to normal
sTemp = StrReverse(sTemp)
'Remove extraneous spaces
cleanWords = WorksheetFunction.Trim(sTemp)
End With
End Function
Limitations
punctuation will not be removed
a "word" is defined as containing only the characters in the class [_A-Za-z0-9] (letters, digits and the underscore).
if any words might be hyphenated, or contain other non-word characters
in the above, they will be treated as two separate words
if you want it treated as a single word, then we might need to change the regex
General steps:
Write cell to array (already working)
for each element (x), go through each element (y) (already working)
if x is in y AND y is longer that x THEN set x to ""
concat array back into string
write string to cell
String/array manipulations are much faster than operations on cells, so this will give you some increase in performance (depending on the amount of words you need to replace for each cell).
The "last word problem" might be that you dont have a space after the last word within your cells, since you only replace word + " " with " ".
I am downloading some files which have some chineses characters sometimes and apparently String doesn't recognize them.
Any ideas on how I could tell VBA the following :
If there are some unknown characters in the filename then delete them and only keep the first part of the filename which contains normal characters.
Actually each of those special characters will be replaced by a "?".
But the problem is that Msgbox InStr(1, AttachmentName, "?") will return 0 even though MsgBox AttachmentName will display some "?".
I did the following, but as I said above, the "?" are displayed on MsgBox but not truly there so it never satisfies the condition...
If InStr(1, AttachmentName, "?") <> 0 Then
AttachmentName = Mid(AttachmentName, 1, InStr(1, AttachmentName, "?") - 1) & "unknown characters "
End If
This sub removes all Chinese characters from a string.
Private Sub RemoveChinese()
Dim Fun As String
Dim Txt As String
Dim Ch As String
Dim n As Integer
Txt = Selection.Text
For n = 1 To Len(Txt)
Ch = Mid(Txt, n, 1)
If Asc(Ch) = AscW(Ch) Then Fun = Fun & Ch
Next n
MsgBox Fun
End Sub
The point is that Chinese characters are represented by 2 bytes whereas it takes only one to write a Latin character. You must have Chinese language support installed on your computer in order to be able to actually depict them. Hence the ? inserted for unrecognised characters.
I'm trying to prepare a spreadsheet for a report in excel vba. Unforturnately there are some wierd characters here that need to be replaced. Easy enough, except for this chracter:
¦
I can't seem to be able to paste that character into the editor into a string replace function. When I try, the output is _. I then thought to refer to it by it's Chr code. A quick look up said it was Chr(166). http://www.gtwiki.org/mwiki/?title=VB_Chr_Values
Replace(s, "â€" + Chr(166), "...")
But this is not that character at all (at least on Mac excel). I tried:
For i = 1 To 255
Debug.Print Chr(i)
Next i
And I didn't see this character anywhere. Does anyone know how I can reference this character in vba code in order to replace it?
Not sure if regexp is available for vba-mac, but you could simplify your existing code greatly as below.
Uses a sample Strin
Dim strIn As String
strIn = "1â€1â€x123"
Do While InStr(strIn, "â€") > 0
Mid$(strIn, InStr(strIn, "â€"), 3) = "..."
Loop
Click on a cell containing your miscreant character and run this small macro:
Sub WhatIsIt()
Dim s As String, mesage As String
Dim L As Long
s = ActiveCell.Text
L = Len(s)
For i = 1 To L
ch = Mid(s, i, 1)
cd = Asc(ch)
mesage = mesage & ch & " " & cd & vbCrLf
Next i
MsgBox mesage
End Sub
It should reveal the characters in the cell and their codes.
It's dirty, but here's the workaround that I used to solve this problem. I knew that my issue character was always after "â€", so the idea was to replace the character that came after those 2. I don't really know how to replace a character at a position in a string, so my idea was to covert the string to an array of characters and replace the array at those specific indexes. Here's what it looks like:
Do While InStr(s, "â€") > 1
num2 = InStr(s, "â€")
arr = stringToArray(s)
arr(num2 - 1) = "<~>"
arr(num2) = "<~>"
arr(num2 + 1) = "<~>"
s = Replace(arrayToString(arr), "<~><~><~>", "...")
Loop
...
Function stringToArray(ByVal my_string As String) As Variant
Dim buff() As String
ReDim buff(Len(my_string) - 1)
For i = 1 To Len(my_string)
buff(i - 1) = Mid$(my_string, i, 1)
Next
stringToArray = buff
End Function
Function arrayToString(ByVal arr As Variant) As String
Dim s As String
For Each j In arr
s = s & j
Next j
arrayToString = s
End Function
In practice, what I replaced those indexes with is something that had to be unique but recognizable. Then i can replace my unique characters with whatever I want. There are sure to be edge cases, but for now it gets the job done. stringToArray function pulled from: Split string into array of characters?