Excel formatting cells

Question

I have a sheet which has date with extra space at end. And i want to remove them so that i can format them as date and sort excel sheet. I used macros available online for ex:

Sub TrimColumnA()
  Dim rng As Range
  On Error Resume Next ''#if entire column is blank, exit sub
  Set rng = Intersect(Range("B1").EntireColumn, ActiveSheet.UsedRange)
  rng.Value = Evaluate("IF(ROW(" & rng.Address & "),IF(" & rng.Address & _
  "<>"""",TRIM(" & rng.Address & "),""""))")
End Sub

I also tried other macros, it works and removes spaces but i have to double click in each cell and then they format into date. How can i avoid clicking and directly remove space and format them into date.

Version- Excel 2007

Answer 1

I don't think you care if the cell is empty. Maybe for speed considerations, but only if you're using TRS80

Sub MakeDates()

    Dim rCell As Range

    For Each rCell In Intersect(ActiveSheet.Columns(2), ActiveSheet.UsedRange).Cells
        If Not rCell.HasFormula Then
            rCell.Value = Trim(rCell.Value)
        End If
    Next rCell

End Sub

This will skip any formulas, but otherwise it just trims what's already in the range.

Answer 2

So, all you want to do is select the cells after trimming them so that the formatting will take effect? If so this is a procedure I have used for that purpose on a column of data where I start the macro when I am at the top of the column in question and I want to go down as long as there is something in the cell.

Sub Double_Click_Cells()
Dim iOS As Integer

  Application.Calculation = xlCalculationManual
  iOS = 0
  While Not IsEmpty(ActiveCell.Offset(iOS))
    ActiveCell.Offset(iOS).Formula = ActiveCell.Offset(iOS).Formula
    iOS = iOS + 1
  Wend
  Application.Calculation = xlCalculationAutomatic

End Sub

Is this what you need?

Answer 3

也许是我误会了，但是您不能只选择该列，按CTRL-H并用任何内容替换空格吗？

Answer 4

I used following code and changed it and it is working for my scenario. Thank you all for your answers and time

Sub RemoveTrailing()
'Code removes leading and trailing spaces (both ASCII 32 and 160) from a selected range of cells 
Dim cel As Range, rg As Range 
Application.ScreenUpdating = False 
Set rg = Intersect(Selection, ActiveSheet.UsedRange) For Each cel In rg
    If Not IsError(cel) Then
        If cel <> "" Then cel.Value = Trim(Application.Substitute(cel.Value, Chr(160), " "))
    End If
Next cel
Application.ScreenUpdating = True
End Sub