Speed-up VBA code to Clean & Trim cells

[opazzo]

Hi there,

Happy new year to all.

I am using the following code to clean-up cells before processing data. I was wondering if anyone had ideas on how to speed up the code (besides the screenupdating and manual calculation, of course).

Thx


-----
For x = 6 To LastRow
Range("D" & x).Value = Application.WorksheetFunction.Trim(Range("D" & x))
Range("D" & x).Value = Application.WorksheetFunction.Clean(Range("D" & x))

Range("E" & x).Value = Application.WorksheetFunction.Trim(Range("E" & x))
Range("E" & x).Value = Application.WorksheetFunction.Clean(Range("E" & x))

Range("F" & x).Value = Application.WorksheetFunction.Trim(Range("F" & x))
Range("F" & x).Value = Application.WorksheetFunction.Clean(Range("F" & x))

Range("G" & x).Value = Application.WorksheetFunction.Trim(Range("G" & x))
Range("G" & x).Value = Application.WorksheetFunction.Clean(Range("G" & x))

Range("X" & x).Value = Application.WorksheetFunction.Trim(Range("X" & x))
Range("X" & x).Value = Application.WorksheetFunction.Clean(Range("X" & x))
Next
-----

 

[chirp]

not sure what sort of speed increase you are looking for but generally it is faster to fill a variant array with data from your range, operate on that array, then update the entire range...so something like

dim v as variant
dim i as long

v=range("D6:D" & lastRow).value2

for i =lbound(v) to ubound(v)
    v(i,1)=application.worksheetfunction.clean(application.worksheetfunction.trim(v(i,1)))

next

range("D6:D" & lastRow)=v

 

[chirp]

oh what i did not really read your question...this just loops through for column d...but it extends easily into the other dimensions where you just need to loop through all "column dimensions" of your range array which can be done by using the syntax

ubound(vArray,2)

 

[chirp]

as a function it would look like this:

Public Function fixRange(inputRange As Range)

Dim v As Variant
Dim i As Long, j As Long, lRow As Long, uRow As Long
Dim rTmp As Range
Dim tStr As String

'exits if not valid input
If inputRange Is Nothing Then Exit Function

For Each rTmp In inputRange.Areas
    'assign range values to array
    v = rTmp.Value2
    
    'operate on array
    lRow = LBound(v)
    uRow = UBound(v)
    
    With Application.WorksheetFunction
        For j = LBound(v, 2) To UBound(v, 2)
            For i = lRow To uRow
                tStr = .Clean(.Trim(v(i, j)))  'note that this trim removes dub spaces within the string..not only trailing/leading
                
                'this *should* preserve any numbers as numbers and not strings
                If IsNumeric(tStr) Then
                    v(i, j) = CDbl(tStr)
                Else
                    v(i, j) = tStr
                End If
            Next
        Next
    End With
    
    'assign array values back to range
    rTmp = v
Next

End Function

there might be a better non looping way to do this, but this type of solution is probably quick enough for whatever you are doing