Deleting contents of cells in non contiguous ranges

[Richard Buttrey]

Hi,

I have a workbook with several sheets. Each sheet has several ranges
of cells containing numbers that need to be erased each month. e.g.
B30: X50, B70:X90, B130:X150 etc

At the moment these cells are identified by a specific colour, and I
have a macro which loops through all the cells from B30 to the last
cell in column X on each sheet, tests them to see if they are coloured
with the right colour, and if so deletes the contents of the cell.

I'm sure this is a very inefficient way of doing the job. Can anyone
suggest a better approach?

(Needless to say this is an inherited application, and as the saying
goes, if I was going there, I wouldn't start from here. It's crying
out for turning it into a standard database which can be more easily
manipulated, with reporting tasks feeding off it. Unfortunately I
don't have the time at the moment to re-organise the whole thing).

Usual TIA




__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________

 

[Bob Phillips]

If you don't know in advance which cells are coloured, there seems to be no
alternative (TINA - shiver!)

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[Richard Buttrey]

If you don't know in advance which cells are coloured, there seems to be no
alternative (TINA - shiver!)

Sorry Bob,

Maybe didnt explain that well enough.

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.

Those cells are always coloured and the macro tests for the colour.

I was thinking that perhaps building a union of all these cells, and
then deleting contents in that range object all in one hit might be
preferable than doing each cell in turn.

Is there any way of selecting all cells of a specific colour in a
worksheet? There doesn't appear to be an F5 Special Cells Colour
option which would be an obvious choice.

Regards



__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________

 

[Bob Phillips]

If they are always the same cells, surely the colour is irrelevant. Couldn't
you just use

range("B30:X50,B70:X90,B130:X150").ClearContents

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

 

[Richard Buttrey]

If they are always the same cells, surely the colour is irrelevant. Couldn't
you just use

range("B30:X50,B70:X90,B130:X150").ClearContents

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
__________________________

 

[Pete_UK]

Richard,

are you saying that every cell in the range B30:X50 has to have its
contents erased? If that is the case, you only need to check down
column B looking for coloured cells and build up the start_row and
end_row from that. Seems pointless in checking every cell in the range
(unless I'm missing something).

Pete

 

[Richard Buttrey]

Richard,

are you saying that every cell in the range B30:X50 has to have its
contents erased? If that is the case, you only need to check down
column B looking for coloured cells and build up the start_row and
end_row from that. Seems pointless in checking every cell in the range
(unless I'm missing something).

Pete

Thanks Pete,

Good idea. I'll give that a go.

Rgds
__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________

 

[Peter T]

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

 

[Peter T]

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

 

[Richard Buttrey]

Peter,

Thanks for taking the time to post this.

I'll give it a whirl during the week and compare it with my current
routine.

Regards

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

__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________