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 开发者_StackOverflowdate 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
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.
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?
Maybe I'm misunderstanding, but can't you just select the column, hit CTRL-H and replace space with nothing?
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
精彩评论