Deleting contents of cells in non contiguous ranges
PS, forgot to add if sheets might have a large usedrange, eg much more than
20 rows you might want to limit the rng, eg
Set rng = Intersect(ws.UsedRange, ws.Rows("2:30"))
this eg assumes you never need to check row 1 and below row 30
Regards,
Peter T
"Peter T" <peter_t@discussions wrote in message
...
Which works fine, but takes 20 minutes or so.
In your earlier reply to Bob you said
"The one consistent thing about these ranges is that they always go
from Col B to Col X and always have the same number of rows - say 20."
You also said 15-20 sheets, so shouldn't take 20 minutes, even in a very
slow system.
15-20 sheets x 20 rows x 200 columns with 20% coloured cells shouldn't
take
more than a few seconds.
Option Explicit
Sub Sample()
Dim r As Long, c As Long, s As String
Dim x, cnt As Long
' 6 Sheets with red in random cells
Range("a1:GR20").Value = 1
For r = 1 To 20
For c = 1 To 200
x = Int(Rnd * 5) + 1
If x = 3 Then
Cells(r, c).Interior.ColorIndex = 3
Cells(r, c) = 222
cnt = cnt + 1
End If
Next
Next
s = ActiveSheet.Name
For c = 1 To 5
Worksheets(s).Copy After:=Sheets(Sheets.Count)
Next
MsgBox "6 x " & cnt & " red cells"
End Sub
Sub test2()
Dim s As String
Dim cel As Range, rng As Range
Dim ws As Worksheet
'clearcontents of all colorindex-3 cells and remove colour
For Each ws In ActiveWorkbook.Worksheets
s = vbNullString
Set rng = ws.UsedRange
For Each cel In rng
If Len(s) 230 Then
fnClear s, rng.Parent
s = vbNullString
End If
If cel.Interior.ColorIndex = 3 Then
s = s & cel.Address(0, 0) & ","
End If
Next
If Len(s) Then
fnClear s, rng.Parent
End If
Next
End Sub
Function fnClear(sAddr As String, ws As Worksheet)
If Right$(sAddr, 1) = (",") Then
sAddr = Left(sAddr, Len(sAddr) - 1)
End If
With ws.Range(sAddr)
.ClearContents
.Interior.ColorIndex = xlNone
End With
End Function
If you want to clear all coloured cells change
If cel.Interior.ColorIndex = 3 Then
to
If cel.Interior.ColorIndex 0 Then
Regards,
Peter T
"Richard Buttrey" wrote in
message ...
On Fri, 31 Mar 2006 20:55:47 +0100, "Bob Phillips"
wrote:
If they are always the same cells, surely the colour is irrelevant.
Couldn't
you just use
range("B30:X50,B70:X90,B130:X150").ClearContent s
Bob,
Yes I could do that. I was hoping to avoid having to hard code or name
these ranges and have some sort of generic code.
There are about 15 sheets with an average of 4 ranges on each sheet.
The other complication is that from time to time the user needs to add
another sheet and add a few more ranges. Without some sort of generic
code the macro would need to be added to each time.
At the moment I just specify the whole of columns A:X from the first
row to the last row on the sheet and loop through every cell checking
the colour and clearing as necessary.
Which works fine, but takes 20 minutes or so.
Rgds
__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________
|