Excel delete everything after a double space

Question

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?

Answer 1

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.

Answer 2

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

Answer 3

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