Non intersect address in Range - vba

Question

I have two ranges A2:E2 and B1:B5. Now if I perform intersect operation it will return me B2. I want some way through which I can get my output as B2 to be consider in any one range either A2:E2 and B1:B5. i.e if there is a repeated cell then it should be avoided.
Expected output :
A2,C2:E2,B1:B5
OR
A2:E2,B1,B3:B5
Can anyone help me.

Answer 1

Like this?
Sub Sample()
Dim Rng1 As Range, Rng2 As Range
Dim aCell As Range, FinalRange As Range
Set Rng1 = Range("A2:E2")
Set Rng2 = Range("B1:B5")
Set FinalRange = Rng1
For Each aCell In Rng2
If Intersect(aCell, Rng1) Is Nothing Then
Set FinalRange = Union(FinalRange, aCell)
End If
Next
If Not FinalRange Is Nothing Then Debug.Print FinalRange.Address
End Sub
OUTPUT:
$A$2:$E$2,$B$1,$B$3:$B$5
EXPLANATION: What I am doing here is declaring a temp range as FinalRange and setting it to Range 1. After that I am checking for each cell in Range 2 if it is present in Range 1. If it is then I am ignoring it else adding it using Union to the Range 1
EDIT Question was also cross posted here

Answer 2

From my article Adding a "Subtract Range" method alongside Union & Intersect
This code can be used to
Subtract the intersect of one range from a second range
Return the anti-union of two separate ranges (ie exclude only cells that intersetc)
I use this code in Mappit! to indentify hidden cells (ie Hidden Cells = UsedRange - SpecialCells(xlVisible)).
While this code is relatively lengthy it was written to be very quick on larger ranges, avoiding cell loops
Sub TestMe()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = [a2:e2]
Set rng2 = [b1:b5]
MsgBox RemoveIntersect(rng1, rng2) & " " & rng2.Address(0, 0)
End Sub
Function RemoveIntersect(ByRef rng1 As Range, ByRef rng2 As Range, Optional bBothRanges As Boolean) As String
Dim wb As Workbook
Dim ws1 As Worksheet
Dim rng3 As Range
Dim lCalc As Long
'disable screenupdating, event code and warning messages.
'set calculation to Manual
With Application
.ScreenUpdating = False
.EnableEvents = False
.DisplayAlerts = False
lCalc = .Calculation
.Calculation = xlCalculationManual
End With
'add a working WorkBook
Set wb = Workbooks.Add(1)
Set ws1 = wb.Sheets(1)
On Error Resume Next
ws1.Range(rng1.Address).Formula = "=NA()"
ws1.Range(rng2.Address).Formula = vbNullString
Set rng3 = ws1.Cells.SpecialCells(xlCellTypeFormulas, 16)
If bBothRanges Then
ws1.UsedRange.Cells.ClearContents
ws1.Range(rng2.Address).Formula = "=NA()"
ws1.Range(rng1.Address).Formula = vbNullString
Set rng3 = Union(rng3, ws1.Cells.SpecialCells(xlCellTypeFormulas, 16))
End If
On Error GoTo 0
If Not rng3 Is Nothing Then RemoveIntersect = rng3.Address(0, 0)
'Close the working file
wb.Close False
'cleanup user interface and settings
'reset calculation
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
lCalc = .Calculation
End With
End Function