TRIM & Proper Code VBA

[jeran042]

Hello everyone. I have a piece of code that I am trying to simplify. I want to Trim off any leading/trailing spaces and then convert all text to Proper. I want to apply this to the entire sheet. I do not want to have to select a section in order to run the code.

This is what I have so far:

[Sub ToProperCase()   For Each cell In ActiveSheet.UsedRange.Cells
        cell.Value = WorksheetFunction.Proper(cell.Value)
    Next
    Dim c As Range, rng As Range
    Set rng = Intersect(Selection, Selection.Parent.UsedRange)
    If rng Is Nothing Then
        MsgBox "No cells with values!"
        Exit Sub
    End If
    For Each c In rng
        If Not IsError(c) Then
            c.Value = MEGACLEAN(c)
        End If
    Next c
End Sub
Function MEGACLEAN(varVal As Variant)
Dim NewVal As Variant
If IsMissing(varVal) Then Exit Function
NewVal = Trim(varVal) 'remove spaces
NewVal = Application.WorksheetFunction.Clean(NewVal) 'remove most unwanted characters
NewVal = Application.WorksheetFunction.Substitute(NewVal, Chr(127), "") 'remove ASCII#127
NewVal = Application.WorksheetFunction.Substitute(NewVal, Chr(160), "") 'remove ASCII#160


MEGACLEAN = NewVal
End Function]

 

[Fishboy]

Hello everyone. I have a piece of code that I am trying to simplify. I want to Trim off any leading/trailing spaces and then convert all text to Proper. I want to apply this to the entire sheet. I do not want to have to select a section in order to run the code.

This is what I have so far:

[Sub ToProperCase()   For Each cell In ActiveSheet.UsedRange.Cells
        cell.Value = WorksheetFunction.Proper(cell.Value)
    Next
    Dim c As Range, rng As Range
    Set rng = Intersect(Selection, Selection.Parent.UsedRange)
    If rng Is Nothing Then
        MsgBox "No cells with values!"
        Exit Sub
    End If
    For Each c In rng
        If Not IsError(c) Then
            c.Value = MEGACLEAN(c)
        End If
    Next c
End Sub
Function MEGACLEAN(varVal As Variant)
Dim NewVal As Variant
If IsMissing(varVal) Then Exit Function
NewVal = Trim(varVal) 'remove spaces
NewVal = Application.WorksheetFunction.Clean(NewVal) 'remove most unwanted characters
NewVal = Application.WorksheetFunction.Substitute(NewVal, Chr(127), "") 'remove ASCII#127
NewVal = Application.WorksheetFunction.Substitute(NewVal, Chr(160), "") 'remove ASCII#160


MEGACLEAN = NewVal
End Function]

Hi jeran042, welcome to the boards.

At its most basic this should do what you describe, however depending on how many cells are in the used range of your sheet it the process time will vary:

Sub TidyValues()


Dim Cell As Range


For Each Cell In ActiveSheet.UsedRange
    Cell.Value = Application.WorksheetFunction.Proper(Cell.Value)
    Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)
Next Cell


End Sub

 

[jeran042]

Very Nice, is there a way to define a range? Say A:AK

 

[Rick Rothstein]

Hi jeran042, welcome to the boards.

At its most basic this should do what you describe, however depending on how many cells are in the used range of your sheet it the process time will vary:

Sub TidyValues()


Dim Cell As Range


For Each Cell In ActiveSheet.UsedRange
    Cell.Value = Application.WorksheetFunction.Proper(Cell.Value)
    Cell.Value = Application.WorksheetFunction.Trim(Cell.Value)
Next Cell


End Sub

You could do that without using a loop...

[table="width: 500"]
[tr]
	[td]Sub TrimAndProper()
  ActiveSheet.UsedRange = Evaluate(Replace("IF(@="""","""",PROPER(TRIM(@)))", "@", ActiveSheet.UsedRange.Address))
End Sub[/td]
[/tr]
[/table]

Very Nice, is there a way to define a range? Say A:AK

For my method, like this...

Sub TrimAndProper()
  With Intersect([COLOR="#0000FF"][B]Columns("A:K")[/B][/COLOR], ActiveSheet.UsedRange)
    .Value = Evaluate(Replace("IF(@="""","""",PROPER(TRIM(@)))", "@", .Address))
  End With
End Sub

 

[Fishboy]

Very Nice, is there a way to define a range? Say A:AK

To prevent needing to go to row 1048576 on all 37 columns, try this:

Sub TidyValues()
' Defines variables
Dim cCell As Range, cRange As Range, uCell As Range, uRange, LastRow As Long

' Sets check range as A1:AK1
Set cRange = Range("A1:AK1")
' For each cell in the check range
For Each cCell In cRange
    ' Define LastRow as the last row of the current column
    LastRow = ActiveSheet.Cells(Rows.Count, cCell.Column)
    ' Sets the update range as row 1 to the last row of the current column
    Set uRange = Range(Cells(1, cCell.Column), Cells(LastRow, cCell.Column))
    ' For each cell in the update range
    For Each uCell In uRange
        ' Update the cell value with Proper format
        uCell.Value = Application.WorksheetFunction.Proper(uCell.Value)
        ' Trim the cell value
        uCell.Value = Application.WorksheetFunction.Trim(uCell.Value)
    ' Move to next cell in update range
    Next uCell
' Move to next cell in check range
Next Cell

End Sub

[EDIT] - I wrote this before I saw Rick's reply. Rick's suggestion will definitely be faster / less resource hungry. I suspect something clever could be done like that here too.

[EDIT2] - Yup! Rick has suggested something good for this one too

 

[jeran042]

Rick - This worked PERFECT!
Thank you for your help everyone,

To prevent needing to go to row 1048576 on all 37 columns, try this:

Sub TidyValues()
' Defines variables
Dim cCell As Range, cRange As Range, uCell As Range, uRange, LastRow As Long

' Sets check range as A1:AK1
Set cRange = Range("A1:AK1")
' For each cell in the check range
For Each cCell In cRange
    ' Define LastRow as the last row of the current column
    LastRow = ActiveSheet.Cells(Rows.Count, cCell.Column)
    ' Sets the update range as row 1 to the last row of the current column
    Set uRange = Range(Cells(1, cCell.Column), Cells(LastRow, cCell.Column))
    ' For each cell in the update range
    For Each uCell In uRange
        ' Update the cell value with Proper format
        uCell.Value = Application.WorksheetFunction.Proper(uCell.Value)
        ' Trim the cell value
        uCell.Value = Application.WorksheetFunction.Trim(uCell.Value)
    ' Move to next cell in update range
    Next uCell
' Move to next cell in check range
Next Cell

End Sub

[EDIT] - I wrote this before I saw Rick's reply. Rick's suggestion will definitely be faster / less resource hungry. I suspect something clever could be done like that here too.

[EDIT2] - Yup! Rick has suggested something good for this one too