Reputation: 12628
In Excel I am trying to use Find and Replace on some data to remove everything after a double space. An example of this data is...
The Apples are Green They are supplied by John
The Bannanas are Yellow They are supplied by Tom
The Strawberries are Red They are supplied by Jason
I want the data to look like this...
The Apples are Green
The Bannanas are Yellow
The Strawberries are Red
In Openoffice I can search for ' .*' and replace it with nothing and this works, but with Excel it doesnt.
I do eventually want to work this into a macro but for now I am just trying to get it to work with Find and Replace, can anyone help?
Upvotes: 2
Views: 2082
Reputation: 38551
Here's an alternative way of doing what you are trying to accomplish. I find it gives you more control than Find
and Replace
.
' Get the contents of the cell
Dim s As String
s = Range("A1").Value
' Now write back only what precedes the double space
Range("A1").Value = Left(s, InStr(s, " ") - 1)
The above operates on only one cell. To do the same over many cells, you could do this:
Dim cell As Range
For Each cell In Range("A1:A3")
cell.Value = Left(cell.Value, InStr(cell.Value, " ") - 1)
Next cell
As has been pointed out in other answers, you should replace any troublesome non-break spaces (Chr(160)
) by regular spaces, prior to searching for double spaces:
Dim cell As Range
For Each cell In Range("A1:A3")
cell.Value = Left(cell.Value, _
InStr(Replace(cell.Value, Chr(160), " "), " ") - 1)
Next cell
EDIT Addressing @chris neilsen's comment:
If some of your target cells are devoid of double spaces, then you should check for that prior to using the Left
function lest it raise an error:
Dim cell As Range
Dim i As Long
For Each cell In Range("A1:A5")
i = InStr(Replace(cell.Value, Chr(160), " "), " ")
If i > 0 Then
cell.Value = Left(cell.Value, i - 1)
End If
Next cell
Now, on the very remote chance that some of the target cells contain formulas comprising double spaces (e.g. =A1 & "<space><space>" & A2
), these formulas will be replaced by values. To avoid this, change the conditional to If i > 0 And Not cell.HasFormula Then
.
Upvotes: 2
Reputation: 53166
Search for ' *'
(that is, <space><space>*
)
Note, in the sample text provided, of the two space sequence the second 'space' is actually a
'no break space' (ascii code 160).
To enter this into the search box, type Alt-0160
(on the numeric keypad)
To do this in code, treating a 'no-break space' as a space do this
Sub DeleteAfterDoubleSpace()
Dim ws As Worksheet
Set ws = ActiveSheet
' Replace any non-break spaces
ws.Cells.Replace What:=Chr(160), Replacement:=" ", LookAt:=xlPart
' Replace double space*
ws.Cells.Replace What:=" *", Replacement:="", LookAt:=xlPart
End Sub
Upvotes: 3
Reputation: 12413
This is a slightly different approach to Chris's. I remove all the non-break spaces before searching for space space
.
Your problem is that your strings contain non-break spaces. Space is code 32. Non-break space is code 160. You cannot find space space
because your strings do not contain space space
.
Try the following:
Sub DeleteAfterDoubleSpace()
Dim Pos As Integer
Dim Rng As Range
With Sheets("xxxxx")
' Replace any non-break spaces
.Cells.Replace What:=Chr(160), Replacement:=" ", LookAt:=xlPart
' Find the first cell containing double space, if any
Set Rng = .Cells.Find(" ", .Range("A1"), xlValues, xlPart, xlByRows, xlNext)
Do While True
If Rng Is Nothing Then
' All double spaces removed, exit.
Exit Do
End If
Pos = InStr(Rng.Value, " ") ' Find position of double space within cell
' Extract first Pos-1 characters from cell and set cell to those characters.
Rng.Value = Mid(Rng.Characters, 1, Pos - 1)
Set Rng = .Cells.FindNext(Rng) ' Find the next double space
Loop
End With
End Sub
P.S.
I discovered the non-break spaces by pasting your strings to cell A1 of a worksheet and calling the following routine so:
Call DsplDiag(Range("A1")
The output for the first string is:
T h e A p p l e s a r e G r e e n T h e
54 68 65 20 41 70 70 6C 65 73 20 61 72 65 20 47 72 65 65 6E 20 A0 54 68 65
y a r e s u p p l i e d b y J o h n
79 20 61 72 65 20 73 75 70 70 6C 69 65 64 20 62 79 20 4A 6F 68 6E A0
Notice the two A0's after Green and at the end. A0 is hexadecimal for 160.
Sub DsplDiag(DsplStg As String)
' Output the string DsplStg to the immediate window in both display and
' hexadecimal formats
Dim CharChar As String
Dim CharInt As Integer
Dim CharStg As String
Dim CharWidth As Integer
Dim HexStg As String
Dim Pos As Integer
Dim Printable As Boolean
CharStg = ""
HexStg = ""
For Pos = 1 To Len(DsplStg)
CharChar = Mid(DsplStg, Pos, 1)
CharInt = AscW(CharChar)
Printable = True
If CharInt > 255 Then
CharWidth = 4
' Assume Unicode character is Printable
Else
CharWidth = 2
If CharInt >= 32 And CharInt <> 127 Then
Else
Printable = False
End If
End If
HexStg = HexStg & " " & Right(String(CharWidth, "0") & _
Hex(CharInt), CharWidth)
If Printable Then
CharStg = CharStg & Space(CharWidth) & CharChar
Else
CharStg = CharStg & Space(CharWidth + 1)
End If
If Pos Mod 25 = 0 Then
Debug.Print CharStg
Debug.Print HexStg
Debug.Print
CharStg = ""
HexStg = ""
End If
Next
Debug.Print CharStg
Debug.Print HexStg
End Sub
Upvotes: 3