Compare Ranges by Address

  • Thread starter Thread starter CG Rosén
  • Start date Start date
C

CG Rosén

Hi Group,

Received below code from Tom Ogilvy. It gives me the addresses of the ranges
in Row(2) that is filled by grey color. What I´am trying to do is to compare
another
range to the ranges from the code below. If the new range is within some of
the
found ranges the "old" range should be set to "no color".
Are not clever enough to make an array of the given ranges or to "split"
them to
independent variables for further processing. Thankful for some help to move
along.

Brgds

CG Rosén

Dim rng As Range, cell As Range
Dim rngList() As Range, i As Long

For Each cell In Rows(2).Cells
If cell.Interior.ColorIndex = 15 Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next

If Not rng Is Nothing Then
MsgBox rng.Address
End If
 
Sub Test_Range()

Dim rng As Range, cell As Range
Dim rngList() As Range, i As Long

For Each cell In Rows(2).Cells
If cell.Interior.ColorIndex = 15 Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next

'''If Not rng Is Nothing Then
'''MsgBox rng.Address
'''End If

Dim TestRange As Range
Dim result As Range
Set TestRange = Selection

''' or for example
''' Set TestRange = Range("a4:k27")

Set result = Intersect(TestRange, rng)

If Not result Is Nothing Then
' reset overlap
result.Interior.ColorIndex = 0
End If
End Sub

Patrick Molloy
Microsoft Excel MVP
 
Hi Patrick,

Thanks for your reply. Your code works in the way that the TestRange is set
to ColorIndex =0. If the orginal range
is "longer" than the TestRange, the "old" range is still greyed in the cells
that not was covered by the TestRange

I think I cant figure it out due to the fact that I don´t know how to deal
with the result of the rng.address from Tom´s
code. It comes like "$B$2:$D$2 , $F$2:$G$2 , $K$2:$M$2". How to "strip"
these addresses to an array or separate
variables?

Brgds

CG Rosén


Sub Test_Range()

Dim rng As Range, cell As Range
Dim rngList() As Range, i As Long

For Each cell In Rows(2).Cells
If cell.Interior.ColorIndex = 15 Then
If rng Is Nothing Then
Set rng = cell
Else
Set rng = Union(rng, cell)
End If
End If
Next

'''If Not rng Is Nothing Then
'''MsgBox rng.Address
'''End If

Dim TestRange As Range
Dim result As Range
Set TestRange = Selection

''' or for example
''' Set TestRange = Range("a4:k27")

Set result = Intersect(TestRange, rng)

If Not result Is Nothing Then
' reset overlap
result.Interior.ColorIndex = 0
End If
End Sub

Patrick Molloy
Microsoft Excel MVP
 
Back
Top