Apply code to all sheets

[dcrighton]

Sub TrimEText()
' This module will trim extra spaces from BOTH SIDES and excessive spaces from inside the text.
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Sheets
Dim MyCell As Range
Selection.Cells.SpecialCells(xlCellTypeConstants, 23).Select
For Each MyCell In Selection.Cells
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", " ")
MyCell.Value = Application.WorksheetFunction.Substitute(Trim(MyCell.Value), " ", "")
Next
Next sh
End Sub

This doesn't seem to remove spaces on all sheets in my excel file just the sheet I'm viewing, any suggestions?

 

[Teeroy]

Hi and welcome to the forum.

You are referencing MyCell to a selection which has a sheet parent object so your code will only do those cells, but multiple times.

Selection is rarely required in VBA, it is an artifact of learning from the macro recorder which records clicking on a cell as a selection.

If you want to change all data on all sheets try:

Sub Cull_Spaces()
Dim oRegex As Object, rTest As Range, rCell As Range
Set oRegex = CreateObject("vbscript.regexp")
With oRegex
    .Pattern = "\s{2,20}"
    .Global = True
    For Each sh In ActiveWorkbook.Sheets
        On Error Resume Next
        Set rTest = sh.UsedRange.SpecialCells(xlCellTypeConstants, 23)
        On Error GoTo 0
        If Not rTest Is Nothing Then
            For Each rCell In sh.UsedRange.SpecialCells(xlCellTypeConstants, 23)
                rCell.Value = Trim(.Replace(rCell.Value, " "))
            Next
        End If
        Set rTest = Nothing
    Next
End With
Set oRegex = Nothing
End Sub

This will replace 2-20 spaces with a single space as well as removing leading and trailing spaces.

ps: this was a quick hack without much testing so try it on a copy of your data first.
pps: I think that you only need a 3 rather than 23 in the SpecialCells method/

 

[dcrighton]

it works great for removing spaces before and after text but I also want any single space within text removed and any double spaces or greater dropped down to single spaces.

ex. 12 907 -- after -- 12907
ex. the___ dog -- after -- The dog

 

[Teeroy]

The code already reduces groups of spaces (from 2 to 20) to a single space within the cell contents.
What do you mean by "any single space within text removed"? Do you want
"The Quick Brown Fox"
to become
"TheQuickBrownFox"?

 

[Jonmo1]

Working on the assumption that the original code you posted works (provides the desired result) for just the currently viewed page...

Just remove this line
Selection.Cells.SpecialCells(xlCellTypeConstants, 23).Select

And change this line
For Each MyCell In Selection.Cells
to
For Each MyCell In sh.Cells.SpecialCells(xlCellTypeConstants, 23)



Also, though not 'wrong' persay...
The Dim MyCell As Range should be done at the top (not inside the For Each loop).

 

[dcrighton]

Jonmo1 I have tried your suggestions but I get an error message "Unable to get the SpecialCells property of the Range class"


I appreciate your help,
DC

 

[dcrighton]

Yes Teeroy that is exactly what I want it to do on all sheets and thank you for helping me out. I'll keep trying t figure it out I'm sure its just some minor change to your code to get what I want.

DC

 

[Teeroy]

You can amend the previous code to do what you have asked by changing the pattern and replace, e.g:

Sub Cull_Spaces()
Dim oRegex As Object, rTest As Range, rCell As Range
Set oRegex = CreateObject("vbscript.regexp")
With oRegex
    .Pattern = "\s*"
    .Global = True
    For Each sh In ActiveWorkbook.Sheets
        On Error Resume Next
        Set rTest = sh.UsedRange.SpecialCells(xlCellTypeConstants, 23)
        On Error GoTo 0
        If Not rTest Is Nothing Then
            For Each rCell In sh.UsedRange.SpecialCells(xlCellTypeConstants, 23)
                rCell.Value = Trim(.Replace(rCell.Value, ""))
            Next
        End If
        Set rTest = Nothing
    Next
End With
Set oRegex = Nothing
End Sub

However since the requirement has changed you can use a simplified code:

Sub Cull_Spaces2()
Dim sh, rCell As Range, rTest As Range
For Each sh In ActiveWorkbook.Sheets
    On Error Resume Next
    Set rTest = sh.UsedRange.SpecialCells(xlCellTypeConstants, 23)
    On Error GoTo 0
    If Not rTest Is Nothing Then
        For Each rCell In sh.UsedRange.SpecialCells(xlCellTypeConstants, 23)
            rCell.Value = Replace(rCell.Value, " ", "")
        Next
    End If
    Set rTest = Nothing
Next
End Sub

 

[dcrighton]

That code works great I appreciate all your help you guys are awesome
Thank You