If range is empty, clear other cells

[Guest]

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!

 

[Guest]

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

 

[Guest]

Thanks Jay! I'll try it out and let you know how it goes.

 

[Guest]

EXCELLENT!! It works perfectly! Thank you SO MUCH!