|
-
Jun 15th, 2010, 12:53 AM
#1
Thread Starter
Addicted Member
[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.
-
Jun 15th, 2010, 01:22 AM
#2
Thread Starter
Addicted Member
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.
-
Jun 15th, 2010, 01:50 AM
#3
Thread Starter
Addicted Member
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.
-
Jun 15th, 2010, 01:53 AM
#4
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
-
Jun 15th, 2010, 01:59 AM
#5
Thread Starter
Addicted Member
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
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|