My question is how can I remove a cell or cells from a range object? I asked something very similar earlier and some people pointed me to this question: Remove cell from Range (object)
Accepted answer:
Function getExcluded(ByVal rngMain As Range, rngExc As Range) As Range
Dim rngTemp As Range
Dim rng As Range
Set rngTemp = rngMain
Set rngMain = Nothing
For Each rng In rngTemp
If rng.Address <> rngExc.Address Then
If rngMain Is Nothing Then
Set rngMain = rng
Else
Set rngMain = Union(rngMain, rng)
End If
End If
Next
Set getExcluded = rngMain
End Function
Sub test()
MsgBox getExcluded(Range("A1:M10000"), Range("a10")).Address
End Sub
The accepted answer only works if the excluded range is a single cell - at least that's how it was for me when I tried it. My cells to be excluded have usually more than one cell, so I tried to adapt the code:
My try:
Function getExcluded(ByVal rngMain As Range, rngExcl As Range) As Range
Dim rngTemp As Range
Dim cellTemp As Range, cellExcl As Range
Set rngTemp = rngMain
Set rngMain = Nothing
For Each cellTemp In rngTemp 'go through all cells in established range
If Intersect(cellTemp, rngExcl) Is Nothing Then 'check for each cell if it intersects with the range to be excluded; no overlap -> put it into rngMain
If rngMain Is Nothing Then
Set rngMain = cellTemp
Else
rngMain = Union(rngMain, cellTemp)
End If
Debug.Print "cellTemp: " & cellTemp.Address
Debug.Print "rngMain: " & rngMain.Address
End If
Next cellTemp
Set getExcluded = rngMain
Sub test5()
getExcluded(Range("A1:D3"), Range("B1:C1")).Select
End Sub
The problem seems to occur in the line Set rngMain = Union(rngMain, rng)
. My Debug.Print
statements tell me that cellTemp
is being iterated through as it should; however, even though the line with Union
gets executed and no matter what cellTemp
is, rngMain
stays $A$1
What am I doing wrong?
Building on @Nathan_Sav.
This will allow the addition of many exclude ranges:
Function testexclude(rngMain As Range, ParamArray rngExclude() As Variant) As Range
Dim i As Long
For i = LBound(rngExclude, 1) To UBound(rngExclude, 1)
Dim rngexcluderng As Range
If rngexcluderng Is Nothing Then
Set rngexcluderng = rngExclude(i)
Else
Set rngexcluderng = Union(rngexcluderng, rngExclude(i))
End If
Next i
Dim c As Range
For Each c In rngMain
If Intersect(c, rngexcluderng) Is Nothing Then
Dim r As Range
If r Is Nothing Then
Set r = c
Else
Set r = Union(r, c)
End If
End If
Next c
Set testexclude = r
End Function