Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 84
Default If range is empty, clear other cells

I'm using the following code to clear some cells, when other cells are blank.
--------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngAllParentCells As Range
Dim rngDepCells As Range
Dim rngCell As Range

Set rngAllParentCells = Range("A10:A22")
Set rngDepCells = Intersect(Target, rngAllParentCells)
Application.ScreenUpdating = False
If Not rngDepCells Is Nothing Then
For Each rngCell In rngDepCells.Cells
'Move 1 cell to the right and clear contents
rngCell.Offset(RowOffset:=0, ColumnOffset:=1).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=2).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=3).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=4).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=5).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=6).ClearContents
Next rngCell

End If
Set rngAllParentCells = Nothing
Set rngDepCells = Nothing
Set rngCell = Nothing

End Sub
-------------------------------

This is working just as I want it to. But, now I need to expand it to also
clear another range of cells, too.

For example, if A10 is empty, I need to clear the above identified cells
AND the range C28:E37.

If A11 is empty, clear C41:E50
If A12 is empty, clear C54:E63
If A13 is empty, clear C67:E76
And so on until
If A22 is empty, clear C184:E193

Any ideas? I've tried several things, but no luck.

Thanks!

  #2   Report Post  
Posted to microsoft.public.excel.programming
Jay Jay is offline
external usenet poster
 
Posts: 671
Default If range is empty, clear other cells

Hi Shelly -

The procedure below is yours with the following modifications (let us know
if it needs tuning):

1. Variables 'a' thru 'e' are declared to reference the "satellite" ranges
(that you want deleted). This makes the procedure easy to modify should the
location of or spread between the satellites ever change. As long as
satellites are the same size and column-aligned, the procedure should work
properly.

2. Your 6 'ClearContents' statements have been replaced with a single
statement only as a suggestion; your statements worked just fine.
---------------------------------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngAllParentCells As Range
Dim rngDepCells As Range
Dim rngCell As Range

a = 28 'row number of first "satellite" range
b = 2 'number of left-most column in satellite ranges
c = 10 'number of rows in each satellite range
d = 3 'number of columns in each satellite range
e = 3 'number of blank rows between satellites

Set rngAllParentCells = Range("A10:A22")
Set rngDepCells = Intersect(Target, rngAllParentCells)
Application.ScreenUpdating = False
If Not rngDepCells Is Nothing Then
For Each rngCell In rngDepCells.Cells
'Move 1 cell to the right and clear contents
'Suggested replacement for multiple ClearContents statements
rngCell.Offset(0, 1).Resize(1, 6).ClearContents
'Next statement added to clear satellite ranges
If rngCell = "" Then _
Cells(a + (rngCell.Row - rngAllParentCells.Row) * (c + e), e) _
.Resize(c, e).ClearContents
Next rngCell
End If

Set rngAllParentCells = Nothing
Set rngDepCells = Nothing
Set rngCell = Nothing
Application.ScreenUpdating = True
End Sub
---------------------------------------------------------------------------------

Jay


"Shelly" wrote:

I'm using the following code to clear some cells, when other cells are blank.
--------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rngAllParentCells As Range
Dim rngDepCells As Range
Dim rngCell As Range

Set rngAllParentCells = Range("A10:A22")
Set rngDepCells = Intersect(Target, rngAllParentCells)
Application.ScreenUpdating = False
If Not rngDepCells Is Nothing Then
For Each rngCell In rngDepCells.Cells
'Move 1 cell to the right and clear contents
rngCell.Offset(RowOffset:=0, ColumnOffset:=1).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=2).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=3).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=4).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=5).ClearContents
rngCell.Offset(RowOffset:=0, ColumnOffset:=6).ClearContents
Next rngCell

End If
Set rngAllParentCells = Nothing
Set rngDepCells = Nothing
Set rngCell = Nothing

End Sub
-------------------------------

This is working just as I want it to. But, now I need to expand it to also
clear another range of cells, too.

For example, if A10 is empty, I need to clear the above identified cells
AND the range C28:E37.

If A11 is empty, clear C41:E50
If A12 is empty, clear C54:E63
If A13 is empty, clear C67:E76
And so on until
If A22 is empty, clear C184:E193

Any ideas? I've tried several things, but no luck.

Thanks!

  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 84
Default If range is empty, clear other cells

EXCELLENT!! It works perfectly! Thank you SO MUCH!
Reply
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
clear range of cells if another becomes blank bgg Excel Worksheet Functions 3 January 17th 07 11:32 PM
Count Empty Cells in Range After Cells with Data David Excel Programming 16 September 17th 06 03:03 PM
Automatically clear values from a range of selected cells John Davies Excel Discussion (Misc queries) 1 June 28th 05 04:42 PM
Clear cells range if certain cells are all empty gschimek - ExcelForums.com Excel Programming 6 May 13th 05 10:38 PM
Clear range of cells in different worksheet Tim Kelley Excel Programming 1 December 30th 04 06:54 PM


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

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

About Us

"It's about Microsoft Excel"