Results 1 to 5 of 5

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

  1. #1

    Thread Starter
    Addicted Member
    Join Date
    Mar 2005
    Posts
    222

    Resolved [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
    Last edited by SQLADOman; Jun 15th, 2010 at 03:42 AM.

  2. #2

    Thread Starter
    Addicted Member
    Join Date
    Mar 2005
    Posts
    222

    Re: Need fast way to Format & Trim Values or add formulas in Column/Range

    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
    Last edited by SQLADOman; Jun 15th, 2010 at 03:34 AM.

  3. #3

    Thread Starter
    Addicted Member
    Join Date
    Mar 2005
    Posts
    222

    Re: Need fast way to Format & Trim Values or add formulas in Column/Range

    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
    Last edited by SQLADOman; Jun 15th, 2010 at 10:38 PM.

  4. #4
    Discovering Life Siddharth Rout's Avatar
    Join Date
    Feb 2005
    Location
    Mumbai, India
    Posts
    12,001

    Re: Need a faster way to change the cell format & trim all cell values in a single co

    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
    A good exercise for the Heart is to bend down and help another up...
    Please Mark your Thread "Resolved", if the query is solved


    MyGear:
    ★ CPU ★ Ryzen 5 5800X
    ★ GPU ★ NVIDIA GeForce RTX 3080 TI Founder Edition
    ★ RAM ★ G. Skill Trident Z RGB 32GB 3600MHz
    ★ MB ★ ASUS TUF GAMING X570 (WI-FI) ATX Gaming
    ★ Storage ★ SSD SB-ROCKET-1TB + SEAGATE 2TB Barracuda IHD
    ★ Cooling ★ NOCTUA NH-D15 CHROMAX BLACK 140mm + 10 of Noctua NF-F12 PWM
    ★ PSU ★ ANTEC HCG-1000-EXTREME 1000 Watt 80 Plus Gold Fully Modular PSU
    ★ Case ★ LIAN LI PC-O11 DYNAMIC XL ROG (BLACK) (G99.O11DXL-X)
    ★ Monitor ★ LG Ultragear 27" 240Hz Gaming Monitor
    ★ Keyboard ★ TVS Electronics Gold Keyboard
    ★ Mouse ★ Logitech G502 Hero

  5. #5

    Thread Starter
    Addicted Member
    Join Date
    Mar 2005
    Posts
    222

    Re: Need fast way to Format & Trim Values or add formulas in Column/Range

    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.
    Last edited by SQLADOman; Jun 15th, 2010 at 08:00 PM.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  



Click Here to Expand Forum to Full Width