Add - Trim(Clean())

  • Thread starter Thread starter SANDIND
  • Start date Start date
S

SANDIND

Hi, I have more than 1000 formulaes in one sheet and to all those formulaes I
want to add Trim and Clean function. Is there anyways to add these two
functions to all the formulaes.

Also if there is any option to use a VB code that would trim and clean all
the selected data in spreadshet , this way i could avoid adding those to
formulaes already in sheet.

Thanks for help.
 
Sub ccc()
Dim cell As Range
For Each cell In ActiveSheet.UsedRange.Cells
If Left(cell.Formula, 1) = "=" Then
cell.Formula = Replace(cell.Formula, "=", "=TRIM(CLEAN(") & "))"
End If
Next

End Sub
 
SS,

The procedures below runs off of the selection. In AddFunciton, if a cell
in the selection has a formula, then the TRIM(CLEAN( will be added to the
existing formula and the new formula will be placed in the cell. In
TrimCleanSource, the assumption is that the source data is the true source of
a hard coded cell, i.e. no formulas.

Best,

Matthew Herbert

Sub AddFunction()
Dim rngCell As Range
Dim strText As String

Application.ScreenUpdating = False
For Each rngCell In Selection.Cells
If rngCell.HasFormula Then
With rngCell
'get all of the formula except for the "="
strText = Right(.Formula, Len(.Formula) - 1)
'wrap the new functions into the existing formula
strText = "=Trim(Clean(" & strText & "))"
'insert the new formula
.Formula = strText
End With
End If
Next rngCell

End Sub

Sub TrimCleanSource()
Dim rngCell As Range

Application.ScreenUpdating = False
For Each rngCell In Selection.Cells
With rngCell
.Value = Trim(WorksheetFunction.Clean(.Value))
End With
Next rngCell

End Sub
 
Maybe David McRitchie's TRIMALL macro will do the job without the need for
formulas.

Sub TrimALL()
'David McRitchie 2000-07-03 mod 2000-08-16 join.htm
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim Cell As Range
'Also Treat CHR 0160, as a space (CHR 032)
Selection.Replace what:=Chr(160), replacement:=Chr(32), _
lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
'Trim in Excel removes extra internal spaces, VBA does not
On Error Resume Next 'in case no text cells in selection
For Each Cell In Intersect(Selection, _
Selection.SpecialCells(xlConstants, xlTextValues))
Cell.Value = Application.Trim(Cell.Value)
Next Cell
On Error GoTo 0
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP
 
Back
Top