Rounding a named range with 68,880 cells

[Bernieg]

i'm trying to round named range cells to 3 decimal places to ensure files are not to big.
Named range: "Pod", 1435 rows by 48 column's = 68880 cells

The code below takes 35.75 seconds to run.

Question can it be done faster ?

Regards Bernie

Sub Rounding()
'Timer***************************************************
Application.ScreenUpdating = False
Dim secs1 As Single
Dim secs2 As Single
secs1 = Timer()

Sheets("Capstudy").Select
Dim cell As Object

' Change to 3 decimal places
For Each cell In Range("Pod")
If IsNumeric(cell) Then
cell.Value = WorksheetFunction.Round(cell.Value, 3) ' SETS TO 3 DECIMAL PLACES
End If
Next cell
Range("A2").Select
Application.CutCopyMode = False

' End of code to be timed
secs2 = Timer()
Worksheets("Capstudy").Range("D5").Value = secs2 - secs1
Application.ScreenUpdating = True
End Sub

 

[Fluff]

What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Also do you have any text cells within the range?

 

[Bernieg]

i'm trying to round named range cells to 3 decimal places to ensure files are not to big.
Named range: "Pod", 1435 rows by 48 column's = 68880 cells

The code below takes 35.75 seconds to run.

Question can it be done faster ?

Regards Bernie

Sub Rounding()
'Timer***************************************************
Application.ScreenUpdating = False
Dim secs1 As Single
Dim secs2 As Single
secs1 = Timer()

Sheets("Capstudy").Select
Dim cell As Object

' Change to 3 decimal places
For Each cell In Range("Pod")
If IsNumeric(cell) Then
cell.Value = WorksheetFunction.Round(cell.Value, 3) ' SETS TO 3 DECIMAL PLACES
End If
Next cell
Range("A2").Select
Application.CutCopyMode = False

' End of code to be timed
secs2 = Timer()
Worksheets("Capstudy").Range("D5").Value = secs2 - secs1
Application.ScreenUpdating = True
End Sub

No text in range, previous macro checked
Excel: Microsoft® Excel® for Microsoft 365 MSO (16.0.14228.20216) 64-bit

 

[Bernieg]

What version of Excel are you using?

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)

Also do you have any text cells within the range?

Hi Fluff

No text in range, previous macro checked
Excel: Microsoft® Excel® for Microsoft 365 MSO (16.0.14228.20216) 64-bit

Bernie

 

[Fluff]

Ok, how about

Sub Bernieg()
   With Sheets("Capstudy")
      .Range("Pod").Value = .Evaluate("Round(Pod,3)")
   End With
End Sub

Thanks for updating your profile

 

[Bernieg]

Ok, how about

Sub Bernieg()
   With Sheets("Capstudy")
      .Range("Pod").Value = .Evaluate("Round(Pod,3)")
   End With
End Sub

Thanks for updating your profile

Cheers Jaz

Much appreciated from 35 to 0.07 seconds to process.
Will have to look into how this works.

Bernie

 

[Fluff]

You're welcome & thanks for the feedback.