PDA

View Full Version : How to compare (neighbor) cells within a range object?



stranno
12-07-2011, 05:24 AM
Hi there,

Does anyone know how to compare (non contiguous neighbor) cells within the same range object?

For example:

For each c in rng
if c.value <> next c.value then .....
next c


The question is how to approach next c

What i do now is: first load the rownumbers of the individual cells in an array.
And then approach the items by the index number. But i think there must be a more elegant/efficient way do to this.

Bob Phillips
12-07-2011, 05:47 AM
Can you post the full code? Not fully clear on what you are doing.

stranno
12-11-2011, 04:32 AM
Compare for instance the folowing subs.

Sub CompareRangeCells()
Dim rng, c As Range
Dim i As Integer
For i = 1 To 100
Cells(i, 1) = i
Next
Cells(10, 1) = 2
ActiveSheet.Rows.Hidden = False
Set rng = Range(Cells(1, 1), Cells(100, 1))
For Each c In rng
If c.Offset(1, 0) < c Then c.Offset(1, 0).Interior.ColorIndex = 3
Next
End Sub


and


Sub CompareRangeCellsVisible()
Dim rng, c As Range
Dim i As Integer
For i = 1 To 100
Cells(i, 1) = i
Next
Cells(10, 1) = 2
Cells(8, 1).EntireRow.Hidden = True
Cells(9, 1).EntireRow.Hidden = True
Cells.Interior.ColorIndex = xlNone
Set rng = Range(Cells(1, 1), Cells(100, 1)).SpecialCells(xlCellTypeVisible)
For Each c In rng
If c.Offset(1, 0) < c Then c.Offset(1, 0).Interior.ColorIndex = 3
Next
End Sub


I want to compare Item n with Item n+1.
The second Sub makes clear that Cells.Offset(1,0) is not the same as C (n+1). My question is, how can i compare the value of a certain Cell (Item) in a non contiguous range with the next item in that range?

mikerickson
12-11-2011, 12:33 PM
When working with discontinous ranges, one has to look at the Areas collection.
Sub test()
Dim myRange As Range
Dim currentCell As Range, nextCell As Range
Dim i As Long
Set myRange = Range("A1,B1:B5,C3:C4")

For Each currentCell In myRange.Cells
Set nextCell = NextCellInRange(myRange, currentCell)
If Not nextCell Is Nothing Then
MsgBox "current cell " & currentCell.Address & vbCr & "next cell " & nextCell.Address
Else
MsgBox currentCell.Address & " is the last cell in " & myRange.Address
End If
Next currentCell
End Sub

Function NextCellInRange(aRange As Range, currentCell As Range) As Range
Dim currentArea As Long, currentIndex As Long
Dim nextArea As Long, nextIndex As Long
With aRange
Rem find current index within current area
For currentArea = 1 To .Areas.Count
If Not Application.Intersect(.Areas(currentArea), currentCell) Is Nothing Then Exit For
Next currentArea
With .Areas(currentArea)
For currentIndex = 1 To .Cells.Count
If .Item(currentIndex).Address = currentCell.Address Then Exit For
Next currentIndex
End With

Rem incriment index/area
nextArea = currentArea
nextIndex = currentIndex + 1
If .Areas(nextArea).Cells.Count < nextIndex Then
nextIndex = 1
nextArea = nextArea + 1
End If

Rem return indicated cell
If .Areas.Count < nextArea Then
Rem currentCell is the last in the range, i.e. no next cell
Set NextCellInRange = Nothing
Else
With .Areas(nextArea)
Set NextCellInRange = .Item(nextIndex)
End With
End If
End With
End Function