CODEWITHSUNDEEP
excelvba
Prince M
Prince M

Reputation: 441

How to clear all data EXCEPT columns X, Y & Z AND rows A,B,C?

I have seen this very similar question, and I think the answer by user @SQL Police is great! But I can not figure out how to modify or adapt it to produce the results I am looking for. Here is my (similar, but different) question:

I want to delete everything that is NOT in columns 24 - 26, but also not in rows 1 - 6.

I have code that can do each seperately, but not together.

To delete with specified columns:

Sub ColClear()
Dim ws As Worksheet
Set ws = ActiveSheet

ws.Range(ws.Columns(1), ws.Columns(23)).ClearContents
ws.Range(ws.Columns(27), ws.Columns(ws.UsedRange.End(xlToRight).Column)).Clear

End Sub

To delete with specified rows:

Sub RowClear()
With Sheets("SheetName")
.Rows(7 & ":" & .Rows.Count).ClearContents
End With
End Sub

But how can I do both at once? (The intersection of the two ranges, not the union)

Thanks!

Upvotes: 1

Views: 164

Answers (2)

Excel Hero
Excel Hero

Reputation: 14764

It is a pity that the Excel VBA object model does not provide a Difference() function to complement the included Union() and Intersect() functions.

If it did your task would be as simple as this:

With Difference(ws.[x:z], ws.[1:6])
    .ClearContents
End With

So, let's make a Difference() function that you can call with the above snippet:

Function Difference(r1 As Range, r2 As Range) As Range
    
    Dim x1&, x2&, x3&, x4&
    Dim y1&, y2&, y3&, y4&
    Dim a&, rBox As Range, rUni As Range, rInt As Range
    
    Set rInt = Intersect(r1, r2)
    Set rUni = Union(r1, r2)
    Set rBox = rUni.Areas(1)
    
    For a = 2 To rUni.Areas.Count
        Set rBox = Range(rBox, rUni.Areas(a))
    Next
    
    x1 = rBox.Column
    x2 = rInt.Column - 1
    x3 = rInt.Column + rInt.Columns.Count
    x4 = rBox.Column + rBox.Columns.Count - 1

    y1 = rBox.Row
    y2 = rInt.Row - 1
    y3 = rInt.Row + rInt.Rows.Count
    y4 = rBox.Row + rBox.Rows.Count - 1
    
    Set rUni = Range(Cells(y3, x3), Cells(y4, x4))
    If y2 Then Set rUni = Union(rUni, Range(Cells(y1, x3), Cells(y2, x4)))
    If x2 Then Set rUni = Union(rUni, Range(Cells(y3, x1), Cells(y4, x2)))
    If y2 > 0 And x2 > 0 Then Set rUni = Union(rUni, Range(Cells(y1, x1), Cells(y2, x2)))
    
    Set Difference = rUni
            
End Function

I believe this solves the general case of preserving the contents of the intersection and union of two ranges while clearing everything else.

It also works for smaller ranges, clearing only the corner areas within the box that tightly surrounds the union:

With Difference(ws.[a9:ba11], ws.[v3:z25])
    .ClearContents
End With

Upvotes: 1

Raymond Wu
Raymond Wu

Reputation: 3387

Adapt to your requirement, the basic idea is to get the range of both sides then ClearContents separately:

Option Explicit

Private Sub Test()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    With ws
        Dim bottomLeftRng As Range
        Set bottomLeftRng = .Range(.Cells(7, 1), .Cells(.Rows.Count, 23))
        
        Dim bottomRightRng As Range
        Set bottomRightRng = .Range(.Cells(7, 27), .Cells(.Rows.Count, .Columns.Count))
    End With
    
    bottomLeftRng.ClearContents
    bottomRightRng.ClearContents
End Sub

Upvotes: 3

Related Questions