ExcelBanter - Using Autocorrect to remove spaces

Hi,

Here an example that might help :

Need to adapt the sheet name and range where
you want to execute this procedure.

'---------------------------------------------------
Sub test()
Dim X As String, Are As Range
Dim C As Range, Rg As Range
Dim Search As String, P As Variant
Dim Nb As Integer, Nt As Integer

X = Chr(135)
Search = " "

With Worksheets("Feuil2") 'Name to adapt
.Range("A1:S500").SpecialCells _
(xlCellTypeConstants, 6).Replace Chr(160), ""

Set Rg = .Range("C1:S500"). _
SpecialCells(xlCellTypeConstants, 6)
End With
Application.ScreenUpdating = False
Application.EnableEvents = False

For Each Are In Rg.Areas
If Are.Cells.Count 1 Then
P = Are.Value
For a = 1 To UBound(P, 1)
For b = 1 To UBound(P, 2)
If P(a, b) < "" Then
If Not IsNumeric(P(a, b)) Then
P(a, b) = Trim(P(a, b))
Do
Nb = Len(P(a, b))
P(a, b) = Replace(P(a, b), Search, X)
P(a, b) = Replace(P(a, b), X, " ")
Nt = Len(P(a, b))
Loop Until Nb = Nt
Are(a, b) = P(a, b)
Else
Are(a, b) = Replace(P(a, b), " ", "") * 1
End If
End If
Next
Next
End If
Next
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'---------------------------------------------------

"StackemEvs" a écrit dans le message de groupe de
discussion : ...

Hi,

I am looking at how to remove extra spaces, and have been thinking
about using Autocorrect.

I have been reading another thread which suggested;

For Each cell In Selection
cell.Value = WorksheetFunction.Trim(cell.Text)
Next

What I have been using is;

With Application.AutoCorrect
AddReplacement "Want", "Replace"
End With

Works well within a loop changing any "Replace" text with "Want".
Something I didn't get Substitute to do correctly within a loop.

What I can't get AutoCorrect to do though is work with spaces, so:

With Application.AutoCorrect
AddReplacement "", " "
End With

Would you expect it to do so?

Thanks in advance for any suggestions
Neil

--
StackemEvs
------------------------------------------------------------------------
StackemEvs's Profile: 1402
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=171754

Microsoft Office Help