Tiny Subroutine takes 10 minutes to calc

C

Casey

Noble Gurus and VBA Gods,

I wrote what I thought was a simple procedure to loop through m
spreadsheet, locate any unprotected cells and clear the contents fro
those unprotected cells. Leaving my locked cells alone. The sub doe
what I need it to do, however, it literally took 10 minutes to calc
and task manager said I was at 100% usage. Could someone help me spee
this thing up? Here is the Sub

Private Sub UnlockedCells()
Dim rng As Range

With ActiveSheet
For Each rng In ActiveSheet.UsedRange
If rng.Locked = False Then
rng.ClearContents
End If
Next
End With
End Sub


Many thanks in advance
Case
 
H

Hari

Hi casey,

Neither a Guru nor a VBA god.

2 days ago I learnt about the statement "ActiveSheet.UsedRange". it might
show/give us more number of cells/range being active than they are.

I piched this code from google (dont remeber whos post it was..) and
modified it slightly

Sub last_row()
Dim ExcelLastCell As Range
Dim Row As Long, Col As Integer
Dim LastRowWithData As Long, LastColWithData As Integer
Dim x As Double

Application.ScreenUpdating = False

' ExcelLastCell is what Excel thinks is the last cell
Set ExcelLastCell = Sheets("raw data").Cells.SpecialCells(xlLastCell)

' Determine the last row with data in it
LastRowWithData = ExcelLastCell.Row
Row = ExcelLastCell.Row
x = Sheets("raw data").UsedRange.Rows.Count


Do While Application.WorksheetFunction.CountA(Sheets("raw
data").Range(Cells(Row, "a"), Cells(Row, "r"))) = 0 And Row <> 1
Row = Row - 1
Loop
LastRowWithData = Row
MsgBox LastRowWithData
Application.ScreenUpdating = True
End Sub


Regards,
Hari
India
 
W

William

Hi Casey

The chances are your UsedRange is a lot larger than you think it is. Also
the code should stop the screen updating, switch to manual calculation, etc.
Try this.....

Sub test()
Dim rng As Range, rr As Range
Dim r As Long
Dim c As Long

With Application
..ScreenUpdating = False
..EnableEvents = False
..Calculation = xlCalculationManual
End With

With ActiveSheet

With .Cells
'Find the real last cell
r = .Find("*", .Cells(1), , , xlByRows, xlPrevious).Row
c = .Find("*", .Cells(1), , , xlByColumns, xlPrevious).Column
Set rr = .Range(.Range("A1"), .Cells(r, c))
End With

For Each rng In rr
If rng.Locked = False Then
rng.ClearContents
End If
Next rng
End With

With Application
..Calculation = xlCalculationAutomatic
..ScreenUpdating = True
..EnableEvents = True
End With
End Sub


--
XL2002
Regards

William

[email protected]

| Noble Gurus and VBA Gods,
|
| I wrote what I thought was a simple procedure to loop through my
| spreadsheet, locate any unprotected cells and clear the contents from
| those unprotected cells. Leaving my locked cells alone. The sub does
| what I need it to do, however, it literally took 10 minutes to calc.
| and task manager said I was at 100% usage. Could someone help me speed
| this thing up? Here is the Sub
|
| Private Sub UnlockedCells()
| Dim rng As Range
|
| With ActiveSheet
| For Each rng In ActiveSheet.UsedRange
| If rng.Locked = False Then
| rng.ClearContents
| End If
| Next
| End With
| End Sub
|
|
| Many thanks in advance
| Casey
|
|
| ---
|
|
 
C

Casey

Hari and William,

Thank you both a million. I had to modify William's coding with idea
from Hari because I got a compile error centered around the "Wit
Application .. Screenupdating=false and came up with the following tha
is as close to Instantaneous as I think you could get. Again thanks

Sub UnlockedCells()
Dim rng As Range, rr As Range
Dim r As Long
Dim c As Long

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual


With ActiveSheet

With .Cells
'Find the real last cell
r = .Find("*", .Cells(1), , , xlByRows, xlPrevious).Row
c = .Find("*", .Cells(1), , , xlByColumns, xlPrevious).Column
Set rr = .Range(.Range("A1"), .Cells(r, c))
End With

For Each rng In rr
If rng.Locked = False Then
rng.ClearContents
End If
Next rng
End With

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

End Sub

Case
 
W

William

Hi Casey

It probably worth deleting all rows beneath and all columns to the right of
the last cell in the worksheet. It will probably decrease the file size
considerably and also speed up processing when you are using the file.

--
XL2002
Regards

William

[email protected]

| Hari and William,
|
| Thank you both a million. I had to modify William's coding with ideas
| from Hari because I got a compile error centered around the "With
| Application .. Screenupdating=false and came up with the following that
| is as close to Instantaneous as I think you could get. Again thanks
|
| Sub UnlockedCells()
| Dim rng As Range, rr As Range
| Dim r As Long
| Dim c As Long
|
| Application.ScreenUpdating = False
| Application.EnableEvents = False
| Application.Calculation = xlCalculationManual
|
|
| With ActiveSheet
|
| With .Cells
| 'Find the real last cell
| r = .Find("*", .Cells(1), , , xlByRows, xlPrevious).Row
| c = .Find("*", .Cells(1), , , xlByColumns, xlPrevious).Column
| Set rr = .Range(.Range("A1"), .Cells(r, c))
| End With
|
| For Each rng In rr
| If rng.Locked = False Then
| rng.ClearContents
| End If
| Next rng
| End With
|
| Application.Calculation = xlCalculationAutomatic
| Application.ScreenUpdating = True
| Application.EnableEvents = True
|
| End Sub
|
| Casey
|
|
| ---
|
|
 
Top