• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to reduce time while trimming cells

ThrottleWorks

ThrottleWorks

Excel Ninja
Hi,

I am using below mentioned code to trim each column present in the worksheet.

However this code takes time to complete, can anyone please help me with better solution if possible.

Please note, am not facing any issue with this, it is not urgent for me.
Please help me if you get time.

Code: 
Sub TrimEachCol()
Dim HeaderRng As Range
Dim DeleteBook As Workbook
Dim DeleteSht As Worksheet
Dim rng As Range
Dim TempLr As Long
Dim TempRng As Range
Dim ScrpBk As Workbook
Dim ScrpSht As Worksheet
Dim ColCount As Long

Set HeaderRng = MapSht.Range(MapSht.Cells(2, 1), MapSht.Cells(55, 1))
CLSRawDataDump.Cells.Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteAll
Set DeleteBook = ActiveWorkbook
Set DeleteSht = ActiveSheet
TempLr = CLSRawDataDump.Cells(CLSRawDataDump.Rows.Count, 1).End(xlUp).Row
CLSRawDataDump.Cells.Clear
ColCount = 0
For Each rng In HeaderRng
ColCount = ColCount + 1
Cells.Find(What:="" & rng, After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.EntireColumn.Copy
'--------------------------------------------------
Workbooks.Add
Set ScrpBk = ActiveWorkbook
Set ScrpSht = ScrpBk.Worksheets("Sheet1")
Range("A1").PasteSpecial xlPasteAll
Range("B1:B" & TempLr).FormulaR1C1 = "=TRIM(RC[-1])"
Range("B1:B" & TempLr).Value = Range("B1:B" & TempLr).Value
Range("B1:B" & TempLr).Copy
CLSRawDataDump.Cells(1, ColCount).PasteSpecial xlPasteAll
ScrpBk.Close
DeleteBook.Activate
Next rng
DeleteBook.Close
End Sub
 
There are multiple area where process can be sped up from looking at your code. But would need to look at your data for specific changes. I'd suggest uploading the sample workbook (which works with current code).

FYI - You can measure time it takes to process portion of the code using something like...
Code: 
Dim startTime As Single, endTime As Single

startTime = Timer
'portion of code that you want to measure process time
endTime = Timer
Debug.Print "Code took " &  (endTime - startTime) & " seconds to process"
 
Untested:
Code: 
Sub TrimEachCol()
    Dim HeaderRng             As Range
    Dim DeleteBook            As Workbook
    Dim DeleteSht             As Worksheet
    Dim rng                   As Range
    Dim TempLr                As Long
    Dim TempRng               As Range
    Dim ScrpBk                As Workbook
    Dim ScrpSht               As Worksheet
    Dim ColCount              As Long

    Set HeaderRng = MapSht.Range(MapSht.Cells(2, 1), MapSht.Cells(55, 1))
    CLSRawDataDump.Cells.Copy
    Workbooks.Add
    Range("A1").PasteSpecial xlPasteAll
    Set DeleteBook = ActiveWorkbook
    Set DeleteSht = ActiveSheet
    TempLr = CLSRawDataDump.Cells(CLSRawDataDump.Rows.Count, 1).End(xlUp).Row
    CLSRawDataDump.Cells.Clear
    ColCount = 0
    For Each rng In HeaderRng
        ColCount = ColCount + 1
        Cells.Find(What:="" & rng, After:=ActiveCell, LookIn:=xlFormulas, _
                   LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                   MatchCase:=False, SearchFormat:=False).Activate
        CLSRawDataDump.Cells(1, ColCount).Resize(TempLr).Value2 = Application.Trim(ActiveCell.Resize(TempLr))
    Next rng
    DeleteBook.Close
End Sub
 
Hi @Chihiro sir, sure, I also realized that there are few improvements which I can do, I will post edited code and sample workbook.

Have a nice day ahead. :)
 
From the SpreadsheetGuru, I like this code because it evaluates the whole range at once.

However, given the forced xlCellTypeConstants, it will convert any formula into a value. The function can be run from the Immediate window if desired.

Code: 
Public Function trim_all(gnr As Range)
' ~~ Trim | Replace non-print char
' http://www.thespreadsheetguru.com/the-code-vault/a-fast-way-to-clean-trim-cell-values-with-vba-code

Dim Area As Range
Dim rngConst As Range
  Set rngConst = gnr.SpecialCells(xlCellTypeConstants)
  For Each Area In gnr.Areas
    Area.value = Evaluate("IF(ROW(" & Area.address & "),CLEAN(TRIM(" & Area.address & ")))")
  Next Area

End Function
 
Last edited:
I use this method to trim the used range of a sheet, it is fast

Code: 
Sub CleanTrim()
Dim ws As Worksheet
Dim MyArray As Variant
Dim rng As Range
Dim x As Long, y As Long

goFast False

  Set ws = ThisWorkbook.Sheets("MapSht")
  With ws
      'Set rng = .Range(.Cells(2, 2), .Cells(55, 2))
      Set rng = .UsedRange
 
      With .Application.WorksheetFunction
      'Create Array
       MyArray = rng
 
        For x = LBound(MyArray) To UBound(MyArray)
            For y = LBound(MyArray, 2) To UBound(MyArray, 2)

              If Not IsError(MyArray(x, y)) Then
         
                    MyArray(x, y) = .Clean(.Trim(MyArray(x, y)))
           
              End If
         
           Next y
         Next x
     
  End With
End With
                                   
    'Postback to sheet
     rng = MyArray

goFast True
End Sub

I always use goFast as well

Code: 
Sub goFast(Optional iReset As Boolean = False)

'Turn OFF various application properties
    Select Case iReset
        Case False
          With ThisWorkbook.Application
              .Calculation = xlCalculationManual
              .ScreenUpdating = False
              .DisplayAlerts = False
              .CutCopyMode = False
          End With
     
  'Turn ON various application properties
      Case True
        With ThisWorkbook.Application
              .Calculation = xlCalculationAutomatic
              .ActiveSheet.UsedRange
              .ScreenUpdating = True
              .DisplayAlerts = True
              .CutCopyMode = True
        End With
    End Select

End Sub
 
Last edited:
Try
Code: 
    With Range("a1", Range("a" & Rows.Count).End(xlUp))
        .Value = Application.Trim(.Cells)
    End With
 
shrivallabha said:
Trim method to the array should be used very carefully.
It will fail when any elements have more than 255 characters...
Click to expand...
It depends on xl version.

However Evaluate method has limitation when trimmed characters exceeds 255.
 
Last edited:
You must log in or register to reply here.
Back
Top