Clean up Macro

[Roderick_E]

I work with lots of data that must be matched against other lists of data so I need to make sure the data is clean (no leading/trailing spaces, no commas/periods)

I worked on a macro that allows me clean up the leading/trailing spaces of a selected column:

Sub trimall()
'select ONLY range to trim & run this macro.  Will remove all leading & trailing spaces
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
For Each cel In Selection
cel.Value = Application.WorksheetFunction.Trim(cel.Value)
Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox ("Trim Complete")
End Sub

A couple of problems with my code.

#1 If a person selects an entire column, the code will run all the way through the 65thousand or so rows (too much, it should determine the last populated row & only run as far as that)

#2 I'd like it to also replace commas & periods with spaces & then delete out the extra spaces. I can write a formula that does such a thing but I don't know how the macro syntax works -- see formulas below:

Replace commas -- find position of comma & replace with space, trim space

=IF(ISERROR(TRIM(REPLACE(A1,SEARCH(",",A1),1," "))),A1,TRIM(REPLACE(A1,SEARCH(",",A1),1," ")))

Replace period -- find position of period & replace with space, trim space

=IF(ISERROR(TRIM(REPLACE(A1,SEARCH(".",A1),1," "))),A1,TRIM(REPLACE(A1,SEARCH(".",A1),1," ")))

Thanks for the help

 

[Roderick_E]

Thanks for the help

Hmm, sorry after a bit more research, it looks like I solved my own problem:

Sub trimall()
'select ONLY range to trim & run this macro.  Will remove all leading & trailing spaces
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
For Each cel In Selection
cel.Value = Trim(WorksheetFunction.Substitute(cel.Value, ",", ""))
cel.Value = Trim(WorksheetFunction.Substitute(cel.Value, ".", ""))
cel.Value = Application.WorksheetFunction.Trim(cel.Value)
Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox ("Trim Complete")

End Sub

It still will run all the way to line 65thous if a person selects an entire column, but hey

 

[micro-blades]

Assuming the user is only selecting one column at a time, you can use the RED code below to stop the loop when the last cell with data is reached.

Sub trimall()
'select ONLY range to trim & run this macro.  Will remove all leading & trailing spaces
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

[COLOR="Red"]lastrow = Cells(65536, Selection.Column).End(xlUp).Row[/COLOR]

For Each cel In Selection
cel.Value = Trim(WorksheetFunction.Substitute(cel.Value, ",", ""))
cel.Value = Trim(WorksheetFunction.Substitute(cel.Value, ".", ""))
cel.Value = Application.WorksheetFunction.Trim(cel.Value)
[COLOR="red"]If cel.Row = lastrow Then Exit For[/COLOR]
Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox ("Trim Complete")

End Sub

 

[mooseman]

This also assumes that the user is only selecting one column at a time, But it actually changes the selection to last cell with data.

Sub trimall()
'select ONLY range to trim & run this macro.  Will remove all leading & trailing spaces
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
x = ActiveCell.Address
Cells(65536, Selection.Column).End(xlUp).Activate
y = ActiveCell.Address
Rng = x & ":" & y
Range(Rng).Select

For Each cel In Selection
cel.value = Trim(WorksheetFunction.Substitute(cel.value, ",", ""))
cel.value = Trim(WorksheetFunction.Substitute(cel.value, ".", ""))
cel.value = Application.WorksheetFunction.Trim(cel.value)
Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox ("Trim Complete")

End Sub

 

[mooseman]

This one will work with any range in one column

Sub trimall()
'select ONLY range to trim & run this macro.  Will remove all leading & trailing spaces
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

  
x = ActiveCell.Address ' saves top of selection address
a = ActiveCell.Row + Selection.Rows.Count   'gets range of rows
If a > 65536 Then a = 65536  ' this stops an entire column from exceeding limits

'This checks for selection full of data or starting below the first row
If Cells(a, Selection.Column).End(xlUp).Row <> ActiveCell.Row And Cells(a, Selection.Column).End(xlUp).Row > ActiveCell.Row Then
  Cells(a, Selection.Column).End(xlUp).Activate
  y = ActiveCell.Address   'gets the last row's address
  Rng = x & ":" & y
  Range(Rng).Select  
End If


For Each cel In Selection
cel.value = Trim(WorksheetFunction.Substitute(cel.value, ",", ""))
cel.value = Trim(WorksheetFunction.Substitute(cel.value, ".", ""))
cel.value = Application.WorksheetFunction.Trim(cel.value)
Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox ("Trim Complete")

End Sub

 

[Roderick_E]

This one will work with any range in one column

Sub trimall()
'select ONLY range to trim & run this macro.  Will remove all leading & trailing spaces
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

  
x = ActiveCell.Address ' saves top of selection address
a = ActiveCell.Row + Selection.Rows.Count   'gets range of rows
If a > 65536 Then a = 65536  ' this stops an entire column from exceeding limits

'This checks for selection full of data or starting below the first row
If Cells(a, Selection.Column).End(xlUp).Row <> ActiveCell.Row And Cells(a, Selection.Column).End(xlUp).Row > ActiveCell.Row Then
  Cells(a, Selection.Column).End(xlUp).Activate
  y = ActiveCell.Address   'gets the last row's address
  Rng = x & ":" & y
  Range(Rng).Select  
End If


For Each cel In Selection
cel.value = Trim(WorksheetFunction.Substitute(cel.value, ",", ""))
cel.value = Trim(WorksheetFunction.Substitute(cel.value, ".", ""))
cel.value = Application.WorksheetFunction.Trim(cel.value)
Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    MsgBox ("Trim Complete")

End Sub

Nice work thanks -- it runs very smoothly & very quickly. This should help a lot.