I need an applescript to find " and replace with just a space. I found an awesome script on here that works beautifully to find and replace whole words (hello, world) but when you manipulate the script to find " and replace with a space, the " corrupts the code and it no longer works. I am hoping somebody knows a way to alter this code to make it do what I want or have an other idea. here is the code (code credit goes to adamh):
searchAndReplaceTextInCells("hello", "world")
on searchAndReplaceTextInCells(search_str, replace_str)
tell application "Microsoft Excel"
set search_range to range "A:Z"
set all_found_ranges to {} -- store for the ranges, to manipulate after searching
set found_range to ""
set counter to 0
try
set found_range to find search_range what search_str with match case
on error
log ("No matches found")
end try
if (found_range is not "") then
set first_cell_address to (get address of the cells of found_range) -- we use this to break our loop
repeat while true
set counter to counter + 1
copy found_range to end of all_found_ranges
-- Now look for next result
set found_range to find next search_range after found_range
set cell_address to (get address of the cells of found_range)
if (cell_address = first_cell_address) then
-- have looped around so we are finished!
exit repeat
end if
end repeat
end if
-- walk all the ranges found and do the string replacing
repeat with r in all_found_ranges
set value of r to my replace_chars(the value of r, search_str, replace_str)
end repeat
log ("found and replaced " & counter & " items")
end tell
end searchAndReplaceTextInCells
on replace_chars(this_text, search_string, replacement_string)
set my text item delimiters to the search_string
set the item_list to every text item of this_text
set my text item delimiters to the replacement_string
set this_text to the item_list as string
set my text item delimiters to ""
return this_text
end replace_chars
As " is a reserved character we need to treat it differently when referencing it in strings.
You could use the quote constant as your argument:
searchAndReplaceTextInCells(quote, " ")
..or you could send it in as an escaped character:
searchAndReplaceTextInCells("\"", " ")
Related
I am trying to replace not each space in a single string with line break. String is taken from specific cell, and looks like:
Now, Im trying to replace each space after abbreviation to line break. The abbreviation can be any, so the best way for precaching which space I intend to replace is like: each space after number and before a letter?
The output I want to get is like:
Below is my code, but it will change every space to line break in cell.
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo Exitsub
If Not Intersect(Target, .Columns(6)) Is Nothing Then
Application.EnableEvents = False
Target.Value = Replace(Target, " ", Chr(10))
End If
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
You can try
Target.Value = Replace(Target, "kg ", "kg" & Chr(10))
If you can have other abbreviations like "g" or "t", do something similar for them (maybe in a Sub), just be cautious with the order (replace first "kg", then "g")
Update: If you don't know in advance the possible abbreviations, one attempt is to use regular expressions. I'm not really good with them, but the following routine seems to do:
Function replaceAbbr(s As String) As String
Dim regex As New RegExp
regex.Global = True
regex.Pattern = "([a-z]+) "
replaceAbbr = regex.Replace(s, "$1" & Chr(10))
End Function
The below will replace every 2nd space with a carriage return. For reason unknown to me The worksheet function Replace will work as intended, but the VBA Replace doesnt
This will loop through every character in the defined area, you can change this to whatever you want.
The if statement is broken down as such
(SpaceCount Mod 2) = 0 this part is what enable it to get every 2nd character.
As a side note (SpaceCount Mod 3) = 0 will get the 3rd character and (SpaceCount Mod 2) = 1 will do the first character then every other character
Cells(1, 1).Characters(CountChr, 1).Text = " " is to make sure we are replacing a space, if the users enters something funny that looks like a space but isn't, that's on them
I believe something like this will work as intended for you
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo Exitsub
Application.EnableEvents = False
For CountChr = 1 To Len(Target.Value)
If Target.Characters(CountChr, 1).Text = " " Then
Dim SpaceCount As Integer
SpaceCount = SpaceCount + 1
If (SpaceCount Mod 2) = 0 Then
Target.Value = WorksheetFunction.Replace(Target.Value, CountChr, 1, Chr(10))
End If
End If
Next CountChr
Application.EnableEvents = True
Exitsub:
Application.EnableEvents = True
End Sub
Identify arbitrary abbreviation first
"abbreviations aren't determined ..."
Knowing the varying abbreviation which, however is the same within each string (here e.g. kg ) actually helps following the initial idea to look at the blanks first: but instead of replacing them all by vbLf or Chr(10), this approach
a) splits the string at this " " delimiter into a zero-based tmp array and immediately identifies the arbitrary abbreviation abbr as second token, i.e. tmp(1)
b) executes a negative filtering to get the numeric data and eventually
c) joins them together using the abbreviation which is known now for the given string.
So you could change your assignment to
'...
Target.Value = repl(Target) ' << calling help function repl()
Possible help function
Function repl(ByVal s As String) As String
'a) split into tokens and identify arbitrary abbreviation
Dim tmp, abbr As String
tmp = Split(s, " "): abbr = tmp(1)
'b) filter out abbreviation
tmp = Filter(tmp, abbr, Include:=False)
'c) return result string
repl = Join(tmp, " " & abbr & vbLf) & abbr
End Function
Edit // responding to FunThomas ' comment
ad a): If there might be missing spaces between number and abbreviation, the above approach could be modified as follows:
Function repl(ByVal s As String) As String
'a) split into tokens and identify arbitrary abbreviation
Dim tmp, abbr As String
tmp = Split(s, " "): abbr = tmp(1)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'b) renew splitting via found abbreviation (plus blank)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
tmp = Split(s & " ", abbr & " ")
'c) return result string
repl = Join(tmp, abbr & vbLf): repl = Left(repl, Len(repl) - 1)
End Function
ad b): following OP citing e.g. "10 kg 20 kg 30,5kg 15kg 130,5 kg" (and as already remarked above) assumption is made that the abbreviation is the same for all values within one string, but can vary from item to item.
I completed code to remove any data in front of a string, add some text (with a space) to the front and store it back in the cell.
However, every time I run the macro (to check if changes that I've made are working for example), a new space is added in between the words.
The code that removes anything before the name and adds the required string. I have called a InStr function and stored the value in integer pos. Note that this is in a loop over a specific range.
If pos > 0 Then
'Removes anything before the channel name
cellValue.Offset(0, 2) = Right(cell, Len(cell) - InStr(cell, pos) - 2)
'Add "DA" to the front of the channel name
cellValue.Offset(0, 0) = "DA " & Right(cell, Len(cell) - InStr(cell, pos) - 2)
'Aligns the text to the right
cellValue.Offset(0, 2).HorizontalAlignment = xlRight
End If
An additional "DA" is not being added and I haven't made any other functions to add spaces anywhere. The extra space is not added if adding "DA " is changed to "DA".
I'd prefer not to add another function/sub/something somewhere to search and remove any extra spaces.
What the string is AND what is in front of the string is unknown. It could be numbers, characters, spaces or exactly what I want it to be. For example, it could be "Q-Quincey", "BA Bob", "DA White" etc. I thought that searching through the cell for the string I want (Quincey, Bob, White) and altering the cell as needed would be the best way.
Solution that you all helped me come up with:
If pos > 0 Then
modString = Right(cell, Len(cell) - InStr(cell, pos) - 2)
'Removes anything before the channel name and places it in the last column
cellValue.Offset(0, 2) = modString
'Aligns the last column text to the right
cellValue.Offset(0, 2).HorizontalAlignment = xlRight
cellValue.Offset(0, 2).Font.Size = 8
'Add "DA" to the front of the channel name in the rightmost column
If StartsWith(cell, "DA ") = True Then
cellValue.Replace cell, "DA" & modString
Else
cellValue.Replace cell, "DA " & modString
End If
End If
Maybe this is something you can work with:
Sample data:
Sample code:
Sub Test()
With Sheet1.Range("A1:A4")
.Replace "*quincey", "AD Quincey"
End With
End Sub
Result:
In your examples, it seems you want to replace the first "word" in the string with something else. If that is always the case, the following function, which makes use of Regular Expressions, can do that:
Option Explicit
Function replaceStart(str As String, replWith As String) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.Global = False
.MultiLine = True
.Pattern = "^\S+\W(?=\w)"
replaceStart = .Replace(str, replWith)
End With
End Function
Sub test()
Debug.Print replaceStart("Q-Quincy", "DA ")
Debug.Print replaceStart("BA Bob", "DA ")
Debug.Print replaceStart("DA White", "DA ")
End Sub
The debug.print will -->
DA Quincy
DA Bob
DA White
The regular expression matches everything up to but not including the first "word" character that follows a non-word character. This should be the second word in the string.
A "word" character is anything in the set of [A-Za-z0-9_]
Seems to work on the examples you present.
If you wanted to go about it through a loop you should remove some redundancies in your code. For instance, refering to cell.offset(0,0) doesn't make sense.
I would set the target cells to a range and simply edit that cell with out placing the unwanted strings in another cell.
**EDIT:
I'd try something like this.**
nameiwant = "Quincy"
Set cell = Range("A1")
If InStr(cell, nameiwant) > 0 And Left(cell, 3) <> "DA " Then
cell.Value = "DA " & nameiwant
End If
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 " ".
Ok, first time playing with Applescript today and after 6-7 hours am 'almost' there. Basic premise of this script is that it should read two columns of data out of an Excel spreadsheet, one column is the phone number, the other is an alert. It then writes the message into iMessage/SMS and delivers it.
I have it working off of a CSV well, and now trying to use the source Excel file to bypass the conversion step. I am running into a classic number formatting issue where it reads the number into scientific notation and disrupts the phone number. On converting it back to a normal string iMessage seems to choke on the formatting. (at this point I know its something simple I am missing.)
set phoneCol to "O"
set messageCol to "P"
set startRow to 3
set endRow to 5
set xlsFilePath to (path to desktop as text) & "test.xlsx"
tell application "Microsoft Excel" to open file xlsFilePath
repeat with thisRow from startRow to endRow
tell application "Microsoft Excel"
set targetBuddyPhone to value of cell (phoneCol & thisRow) as string
set targetMessage to value of cell (messageCol & thisRow) as string
end tell
set targetBuddyPhone to number_to_string(targetBuddyPhone)
tell application "Messages"
send targetMessage to buddy targetBuddyPhone of service "SMS"
end tell
delay 2
end repeat
on number_to_string(this_number)
set this_number to this_number as string
if this_number contains "E+" then
set x to the offset of "." in this_number
set y to the offset of "+" in this_number
set z to the offset of "E" in this_number
set the decimal_adjust to characters (y - (length of this_number)) thru ¬
-1 of this_number as string as number
if x is not 0 then
set the first_part to characters 1 thru (x - 1) of this_number as string
else
set the first_part to ""
end if
set the second_part to characters (x + 1) thru (z - 1) of this_number as string
set the converted_number to the first_part
repeat with i from 1 to the decimal_adjust
try
set the converted_number to ¬
the converted_number & character i of the second_part
on error
set the converted_number to the converted_number & "0"
end try
end repeat
return the converted_number
else
return this_number
end if
end number_to_string
by contrast the following scrip to read the same variables from a CSV works with no issues at all, I did need to put a small delay in or I overran the buffer in iMessage.
set theFile to (choose file with prompt "Select the CSV file")
-- read the file contents:
set f to read theFile
-- break the file into paragraphs (c.f. rows)
repeat with row in (paragraphs of f)
-- parse the row into comma-delimited fields
set fields to parseCSV(row as text)
-- now you have your data:
set targetBuddyPhone to item 1 of fields
set targetMessage to item 2 of fields
tell application "Messages"
send targetMessage to buddy targetBuddyPhone of service "SMS"
end tell
delay 2
end repeat
on parseCSV(theText)
set {od, my text item delimiters} to {my text item delimiters, ","}
set parsedText to text items of theText
set my text item delimiters to od
return parsedText
end parseCSV
I am trying to copy the nonblanks cells in my excel file to txt file. My data looks like:
1 2 3
1 2
1
1 2 3 4
So, if i select all and copy, txt file shows like the empty cells have data which is not something that i want.
I tried this:
Crtl+A
Go to special
Constants
Numbers
These commands selects the nonblank cells but I cannot copy them. Is there a way to copy them? I get:
That command cannot be used on multiple selections.
Thanks
If you got notepad++, you can use the regex find and replace to remove all the extra tabs at the end of a line.
Open the txt file in notepad++ and hit Ctrl+H.
In find, put:
\t+$
In replace, leave it blank.
Then check the radio button for the search mode from 'Normal' to 'Regular expression'. After that, hit 'Replace All' and this should be it.
Dim fso As FileSystemObject
Dim stream As TextStream
Dim str As String
Set fso = New FileSystemObject
Set stream = fso.CreateTextFile("c:\myTextFile.txt", True)
For i = 1 To 10
For Each cell In Range("A" & i & "F" & i)
If Not IsEmpty(cell) Then
str = str + cell.Text + " "
End If
Next cell
stream.writeline (str)
str = ""
Next i
stream.Close
End Sub
all you gotta do is change what you wanted separated by ( the " " at the end of the str line) and the range you want ( i = rows 1 through 10 as is) and ("a" & i ":f" & i which indicates a through f, in this case for rows 1 through 10)
hope this helps
With Word as your text editor, copy Excel as is and Paste Special as Unformatted Text. Replace ^t^t with ^t until no more replacements are made, then ^t^p with ^p.