I have a spreadsheet that contains emojis, e.g., 😃, and I am looking for a solution to use Excel VBA to replace the emojis with null.
Emojis can be removed using the Excel replace action, so I recorded a macro to automate the replace. I opened the recorded macro and it was displayed as follows:
Sub Remove_Emojis()
Cells.Replace What:="??", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
End Sub
The problem is that VBA doesn't recognize emojis (😃) and replaces them with "??", i.e., Unicode characters above a certain value are not recognized by VBA.
I tried replacing "??" with ChrW():
Sub Remove_Emojis()
Cells.Replace What:=ChrW(128515), Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
End Sub
but this results in an error:
Invalid procedure call of argument
because the ChrW() function does not allow a value above 65535. Note: The ChrW() function works if the value of the argument is within the range -32,767 to 65,535.
I expect that there should be support for doing this in VBA given that it can be done in Excel.
I did as small experiment, putting your smiley into excel and let the following code run:
Dim s
s = ActiveCell
Dim i As Long
For i = 1 To Len(s)
Dim c
c = Mid(s, i, 1)
Debug.Print i, c, AscW(c)
Next i
My result was
1 ? -10179
2 ? -8701
So obviously, the single character is split into 2 inside VBA. AscW and it's pendant ChrW deal with 16bit, and the emoji is a 32bit char, so in VBA this emoji character is handled as if there are 2 characters in the string
I added the following code and voilà , the smiley char was gone:
Dim x
x = ChrW(-10179) & ChrW(-8701)
s = Replace(s, x, "(smiley)")
ActiveCell.Offset(0, 1) = s
Probably you have to experiment with the different emojis you are facing and build a list in your replacing routine.
Thank you to FunThomas for pointing out that emojis are represented as 2 characters in VBA. The revised VBA code that works based on this:
Sub Remove_Emojis()
Cells.Replace What:=ChrW(-10197) & ChrW(-8701), Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False
End Sub
In my actual solution, I put this into a loop to remove all of the different emojis.
Related
Sub Macro9()
Range("Table57[Weld Done]").Select
Selection.Replace What:="0/1/1900", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True, FormulaVersion:=xlReplaceFormula2
Range("Table57[[#Headers],[Weld Done]]").Select
End Sub
I used the Replace function to replace default date 0/1/1900 with "blank" & it worked. So I recorded the workflow using VBA macro recording function & it gives coding as above.
When I try to use the macro, the value remains as default date 0/1/1900.
Just change "0/1/1900" to 0 will do.
The issue is that the number 0 formatted as date is 0/1/1900
I assume that they are the result of a calculation (you use a formula in those cells).
You can change the .NumberFormat of your range to something like:
[=0]"";D/M/YYYY
and this will hide the zero dates and show the cells as blanks.
I am looping through cells trying to make certain parts of cell values bold. I have a cell with contents:
<b>This part should be bold</b> but this should not be
I can get the correct part to be bold but the next step is to remove the tags. The following lines cause an issue:
Cells.Replace What:="<b>", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="</b>", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
When these lines run (in either order), the whole cell value becomes bold. More specifically, after running it line by line, running either line will have the same result. I am new to VBA and not sure what's causing this.
The function I'm using to make the substring bold is:
fCell.Characters(Start:=m, Length:=n - m + 1).Font.Bold = True
where fCell is being looped over and m and n are the indices locating <b> and </b> respectively.
Once you've set a format for only part of a cell's content, you cannot replace the whole content without losing that partial formatting.
You need to use the Characters method to remove the tags: use Instr() to find the location then set the text there to "":
Sub tester()
RemoveStrings Range("A1"), Array("<b>", "</b>")
End Sub
Sub RemoveStrings(c As Range, Strings)
Dim txt, pos As Long
For Each txt In Strings
Do
pos = InStr(1, c.Value, txt, vbTextCompare)
If pos > 0 Then c.Characters(pos, Len(txt)).Text = ""
Loop While pos > 0
Next txt
End Sub
I have the Following code following recording a macro:
Sub RemoveLetters()
Cells.Replace What:="C ", Replacement:="", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=True, SearchFormat:=False, ReplaceFormat:=False, _
FormulaVersion:=xlReplaceFormula2
End Sub
Which works fine to remove a single character from an active worksheet. The problem I have is that C is just one of a handful of common individual characters I wish to remove How can I modify this or improve upon this to remove a list of given characters instead of just having to copy this for each?
Update:
Some of the data also contains units such as °C. The macro above unfortunately the above code recognises these characters as independent and therefore returns ° only. Does anyone know how I can get around this?
Add some parameters to your Sub and allow passing in an array of text items to be replaced:
Sub Tester()
RemoveLetters ActiveSheet, Array("C ","D ","E ")
End Sub
Sub RemoveLetters(ws As Worksheet, arrTxt)
dim i As Long
for i=lbound(arrTxt) to ubound(arrTxt)
ws.Cells.Replace What:=arrTxt(i), Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, _
MatchCase:=True, SearchFormat:=False
next i
End Sub
I am writing a VB Script to convert Alpha Numerics to Special Characters and Vice-Versa. The script worked fine when I tried to convert Alpha Numeric values to Special Characters but it just returns 'X' when I try to convert Special Characters to Alpha Numeric. I am not sure why. I have pasted the code below. Any help is appreciated.
fnd = Array("~","\",">","!","#","#")
rplc = Array("A", "B", "C","1","2","3")
For x = LBound(fnd) To UBound(fnd)
'Loop through each worksheet in ActiveWorkbook
For Each sht In ActiveWorkbook.Worksheets
sht.Cells.Replace What:=fnd(x), Replacement:=rplc(x), _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=True, _
SearchFormat:=False, ReplaceFormat:=False
Next sht
Next x
There were certain characters that needed an escape character before them. So I replaced
"~", "*", "?"
With
"~~", "~*", "~?"
And it worked. Thanks for all the help.
I am trying to locate the top 10 in a list of thousands of entries, to create an ongoing report of failures of hardware. The report displays a top 10 for various things. For example top 10 errors, top 10 downtime etc. It is used to target engineers to the most critical machines in a manufacturing facility.
Our macro has worked OK for when we have had 255 errors. We have now extended our error list to 2048, and we envisage that our macros will run incredibly slowly.
I have an idea to utilise the Search and Replace function, and utilise the number of replacements to achieve the top 10. Manually a message box is displayed giving this number. When recording this macro, no message box is seen (which is good) but I cannot locate where the number is.
The function returns a Boolean.
Macro recorded looks like this.
Sub searchmacrotest()
' searchmacrotest Macro
Cells.Replace What:="a", Replacement:="AZ", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
Cells.Replace What:="AZ", Replacement:="a", LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub
The first line simply changes the a to Az, and the second changes it back to a. They run quickly and gave a number of 75 with my list.
Logic:
Use a unique word to replace. While choosing ensure that there is no possibility of the word to occur.
Use Countif to count the occurrences of this unique word after replacing
Code: Try this
Sub GetReplaceCount()
Dim ws As Worksheet
'~~> Set this to a word which is unique
Dim magicword As String: magicword = "Sid" & Format(Now, ddmmyyhhmmss)
'~~> This is what you want to replace
Dim searchText As String: searchText = "a"
Set ws = ThisWorkbook.Sheets("Sheet1")
With ws
.Cells.Replace What:=searchText, Replacement:=magicword, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
'~~> This will give you the number of occurences
Debug.Print Application.WorksheetFunction.CountIf(.UsedRange, "*" & magicword & "*")
.Cells.Replace What:=magicword, Replacement:=searchText, LookAt:=xlPart, SearchOrder _
:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End With
End Sub