LinkBack Thread Tools Search this Thread Display Modes
Prev Previous Post   Next Post Next
  #8   Report Post  
Posted to microsoft.public.excel.worksheet.functions,microsoft.public.excel.programming
Richard Buttrey
 
Posts: n/a
Default Deleting contents of cells in non contiguous ranges


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


On Sat, 1 Apr 2006 17:48:34 +0100, "Peter T" <peter_t@discussions
wrote:

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
__________________________





__
Richard Buttrey
Grappenhall, Cheshire, UK
__________________________
 
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
How do I combine the contents of multiple cells in one cell? Debbie Excel Worksheet Functions 3 December 16th 05 10:57 PM
exchange contents of cells \jeremy via OfficeKB.com\ New Users to Excel 6 July 8th 05 03:14 AM
How to insert the contents of two cells in a footer? Pank Excel Discussion (Misc queries) 4 June 2nd 05 02:32 PM
Deleting #N/A from cells... Jambruins Excel Discussion (Misc queries) 3 February 22nd 05 11:36 PM
Adding contents of cells by clicking in Excel 2002 Kevin Gordon Excel Discussion (Misc queries) 7 January 11th 05 04:49 PM


All times are GMT +1. The time now is 01:03 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"