removing excessive spaces

[Craig68]

Hi,
I have the following code to remove excess spaces from the selected range (this could even be a single cell).
The problem is I get a run-time error if the selection is empty.
What I would like is to check the selection and if all cells are empty then pop-up a message "Selection is empty"
If not then carry on.

Sub Remove_Spaces()
    Dim r As Range
    With Application.WorksheetFunction
    For Each r In Intersect(Selection, ActiveSheet.UsedRange)
        r.Value = .Trim(r.Value)
    Next r
    End With
End Sub

 

[Alex Blakenburg]

If the selected cells are empty, it should not cause a run-time error. If all the selected cells are outside the used range you will get a Run-Time error '424' Object required.
What error message are you getting and what line of code is highlighted when you click on debug ?

The below would avoid the 424 error:

Sub Remove_Spaces()
    Dim r As Range
    Dim rng As Range
    
    Set rng = Intersect(Selection, ActiveSheet.UsedRange)
    
    'If rng Is Nothing Then Exit Sub
    With Application.WorksheetFunction
        For Each r In rng
            r.Value = .Trim(r.Value)
        Next r
    End With
End Sub

 

[SunnyAlv]

like this ?

Sub Remove_Spaces()
    'On Error Resume Next
    
    Dim r As Range
    With Application.WorksheetFunction
    
            If .CountA(Selection) = 0 Then
                MsgBox "Cell Is Empty"
                Exit Sub
            End If
            
    For Each r In Selection
            r.Value = .Trim(r.Value)
    Next r
    End With
End Sub

 

[Craig68]

Thanks for the reply, this is the error message when the selected range is empty.

I have tried your code and still get the same error.
This line is highlighted when using your code "For Each r In rng"
This line was highlighted in my original code "For Each r In Intersect(Selection, ActiveSheet.UsedRange)"

Sub Remove_Spaces()
    Dim r As Range
    Dim rng As Range
    
    Set rng = Intersect(Selection, ActiveSheet.UsedRange)
    
    'If rng Is Nothing Then Exit Sub
    With Application.WorksheetFunction
        For Each r In rng
            r.Value = .Trim(r.Value)
        Next r
    End With
End Sub

 

[Craig68]

Thankyou this works perfectly

like this ?

Sub Remove_Spaces()
    'On Error Resume Next
   
    Dim r As Range
    With Application.WorksheetFunction
   
            If .CountA(Selection) = 0 Then
                MsgBox "Cell Is Empty"
                Exit Sub
            End If
           
    For Each r In Selection
            r.Value = .Trim(r.Value)
    Next r
    End With
End Sub

 

[Alex Blakenburg]

I have tried your code and still get the same error.

Oops I was doing some more testing and forgot to uncomment the If statement line.
Just remove the single quote (comment mark) from the If Statement

 

[Alex Blakenburg]

Thankyou this works perfectly

Just and FYI - Sunny's code is not working because of the "empty" test but because it has removed using the Intersect with the used range requirement.
It just uses whatever cells were selected.
If you know for a fact that you are going to only ever run it on a contiguous set of cells you don't even need to loop.