[RESOLVED] Need fast way to Format & Trim Values or add formulas in Column / Range

I Have a column of cells with mixed formatting that I need to both trim leading and trailing spaces, and change the format to text.

This works but is very slow.

Thanks in advance. Needs to work in both Excel 2003 and 2007

Code:

---

Dim Rng As Range
Dim tbl As Range
 
 Set tbl = Range("G2:G30000")
 
    For Each Rng In tbl
        On Error Resume Next
   
            Rng.NumberFormat = "@"
            Rng = Trim(Rng)
    Next

---

Can this be done with the find method ? This is what I have so far -> I know using the asterisk is wrong.

Code:

---

  Dim c As Range, firstAddress As String
  Dim Anyvalue
  Anyvalue = "*" '<-What can I put here so I can perform an operation on every cell?
  On Error Resume Next
  Set c = .Find(Anyvalue, LookIn:=xlValues)
 
With ActiveSheet.Range("G2:G30000")
    If Not c Is Nothing Then
        firstAddress = c.Address
      Do
        c.NumberFormat = "@"
        c = Trim(c)
     
    Set c = .FindNext(c)
   
      Loop While Not c Is Nothing And c.Address <> firstAddress
  End If
End With

---

I found this code with a google search for Triming the leading and trailing spaces in a column quickly

Is there a way I can incorporate r.NumberFormat = "@" into that code ?

http://www.ozgrid.com/forum/showthread.php?t=77535

Code:

---

Sub TrimCol()
Dim r As Range
Set r = Intersect(Range("G1").EntireColumn, ActiveSheet.UsedRange)
r.Value = Evaluate("IF(ROW(" & r.Address & "),IF(" & r.Address & "<>"""",TRIM(" & r.Address & "),""""))")
End Sub

---

I tried doing it as shown below and it works. At least I have not encountered any issue with it yet, so maybe I should reword and say that it apparently works.

And it is lightning fast. 30,000 cells in about 1/2 of a second.

If anyone can explain to me a little about how and why it works, that would be great !

Thanks

Code:

---

http://www.ozgrid.com/forum/showthread.php?t=77535

Dim r As Range
Set r = Intersect(Range("G1").EntireColumn, ActiveSheet.UsedRange)

r.NumberFormat = "@"
r.Value = Evaluate("IF(ROW(" & r.Address & "),IF(" & r.Address & "<>"""",TRIM(" & r.Address & "),""""))")

---

Edit #1: After a lot of testing, the code above does in fact work great.

Edit #2:
This is so handy for so many things.

For example, several times I have had my users accidentally erase some of my formulas in Column N that starting at Cell N 16 down sums all the values from three other columns to show the total in column N. -- Some times the the required format of the cell was also changed.

Locking the formula cells and using sheet protection was not an option because my users often need to unprotected the sheet in order to do their work.

Now that I know about the commands in this threads solution, its as simple as the routine below to repair the formula in every cell in Column N. It only takes a blink of an eye to process every cell from cell N16 down to cell N50,000 with re-formatting the cell to "general" and re-entering the formula.

Code:

---

Dim rng As Range
Dim wks As Object
Dim LastRow As Long

Set wks = ActiveSheet

With wks
  LastRow = .[B65536].End(xlUp).Row
  'Need this range so that cells above N16 are not affected.
  Set rng = .Range(.Cells(16, 1), .Cells(LastRow, 14))
End With

Dim r As Range
   
    ' Set r = Intersect(Range("N1").EntireColumn, rng)
    ' Columns(14) is the equivalent to Range("N1").EntireColumn
    Set r = Intersect(Columns(14), rng)
   
    r.ClearContents
   
    r.NumberFormat = "General"
     
      r.FormulaR1C1 = "=RC[-5]*RC[-2]+RC[-4]"

---

]
Edit # 3:
In playing around with it I discovered that for this particular use the Intersect Command is not needed. - Intersect apparently is only serving the purpose of specifying both Column N and Excels Used Range as away to limit the range from cell N1 to to the last used row in Column N..

I re-wrote both the routine's above using a different method to determine my used range and I did away with the Intersect command.
Doing it this way gives me easier more transparent flexibility with the Range. - My Range is cell N16, instead of the entire columns used range, as to avoid processing the cells N15, N14, N13 etc..

The two routines below do the same thing as the two routines above except with more control over the range to process. Both are equally as fast.

Code:

---

Sub TrimColumnRangeOfCellsAndFormatToText()

Dim rng As Range
Dim wks As Object
Dim LastRow As Long

Set wks = ActiveSheet

With wks
    LastRow = .[B65536].End(xlUp).Row

    Set rng = .Range("E16", Range("E" & LastRow))
End With
     
    rng.NumberFormat = "@"

      rng.Value = Evaluate("IF(ROW(" & rng.Address & "),IF(" & rng.Address & _
    "<>"""",TRIM(" & rng.Address & "),""""))")
   
End Sub

---

And this other routine that Clears contents, formats all the cells in the range as general and enters the formula.

Code:

---

Sub Column_Reset_Format_and_Formulas()

Dim rng As Range
Dim wks As Object
Dim LastRow As Long

Set wks = ActiveSheet

With wks
    LastRow = .[B65536].End(xlUp).Row

    Set rng = .Range("N16", Range("N" & LastRow))
End With
 
    rng.ClearContents
   
    rng.NumberFormat = "General"
     
    rng.FormulaR1C1 = "=RC[-5]*RC[-2]+RC[-4]"
   
End Sub

---

Code:

---

Sub Sample1()
    Dim r As Range
   
    Set r = Intersect(Range("G1").EntireColumn, ActiveSheet.UsedRange)
   
    r.Value = Evaluate("IF(ROW(" & r.Address & "),IF(" & r.Address & _
    "<>"""",TRIM(" & r.Address & "),""""))")
   
    r.NumberFormat = "@"
End Sub

---

Thanks koolsid

Wow ! , that does the job so fast on 30,000 cells I nearly fell over. Even 60,000 cells are complete in less than one second. :thumb: