MS VBA with loops and unions - excel

Question

Dim Counter As Integer
Dim Maxhouse As Integer
Dim FindHouse As Range
Dim RangeVar As Range
Dim HousesRange As Range
For Counter = 1 To MaxHouse
ActiveSheet.Cells(16, 2 + Counter).Select
House = ActiveCell
With Sheets("Sheet1").Range("C:KP")
Set FindHouse = Cells.Find(What:=House, _
After:=Cells(17, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not FindHouse Is Nothing Then
If Counter = 1 Then
Set HousesRange = FindHouse
Else
Set RangeVar = FindHouse
Set HousesRange = Union(HousesRange, RangeVar)
End If
End If
End With
Next Counter
For Each RCell In HousesRange.Cells
Application.Goto RCell, True
Next RCell**
Now my problem is with the for loop which traverses through the named range 'HousesRange'
So lets say that HousesRange contains [2,5,9,10].
Here HousesRange is a subset of the row [1,2,3,4,5,6,7,8,9,10] in my Sheet
And lets assume that HousesRange was established through the order of [9,10,5,2] (through the 1st for loop with the union).
Now as I traverse through HousesRange with just rCells (the second for loop), it takes me to 9, 10, 5 then 2.
But I want it to take me to 2, 5, 9 then 10
Can some body shed some light to this?
I had always thought that named ranges are ALWAYS traversed through left to right and then top to bottom.
Thank you so much in advance

Answer 1

Ok this is the long way round, but it should work:
Instead of using Union build your list of found houses in a dictionary object.
Then sort the ranges using Bubblesort HouseRangeDic
You should finally be able to use it in the right order:
Dim Counter As Integer
Dim Maxhouse As Integer
Dim FindHouse As Range
Dim RangeVar As Range
Dim HousesRange As Range
'****** NEW **********
Dim foundHouseCount
foundHouseCount = 1
Dim HouseRangeDic
Set HouseRangeDic = CreateObject("Scripting.dictionary")
'*********************
For Counter = 1 To Maxhouse
ActiveSheet.Cells(16, 2 + Counter).Select
House = ActiveCell
With Sheets("Sheet1").Range("C:KP")
Set FindHouse = Cells.Find(What:=House, _
After:=Cells(17, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not FindHouse Is Nothing Then
HouseRangeDic.Add foundHouseCount, RangeVar '**** NEW ***
foundHouseCount = foundHouseCount + 1 '**** NEW ***
End If
End With
Next Counter
'**** NEW ***
Bubblesort HouseRangeDic
For i = 1 To HouseRangeDic.Count
Application.Goto HouseRangeDic(i), True
Next
'************
Sub Bubblesort(ByRef rangeDic)
Dim tempRange
For i = 1 To rangeDic.Count - 1
For j = i To rangeDic.Count
If rangeDic(i).Address > rangeDic(j).Address Then
Set tempRange = rangeDic(i)
Set rangeDic(i) = rangeDic(j)
Set rangeDic(j) = tempRange
End If
Next
Next
End Sub

Answer 2

See if this works for you. Notice my "After:=" is set to the LAST cell of the range, so the first find starts at the beginning of the range.
Sub loopCells()
Dim FindHouse As Range
Dim HousesRange As Range
Dim rcell As Range
Dim r As Range
Dim sAdd As String
Dim House As Long
Set r = Sheets("Sheet1").Range("$C$15:$K$20") 'change to suit
House = 11'change to suit
With r
Set FindHouse = .Find(What:=House, After:=r(.Cells.Count), LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
If Not FindHouse Is Nothing Then
sAdd = FindHouse.Address
Do
If HousesRange Is Nothing Then
Set HousesRange = FindHouse
Else
Set HousesRange = Union(HousesRange, FindHouse)
End If
Set FindHouse = .FindNext(FindHouse)
Loop While Not FindHouse Is Nothing And FindHouse.Address <> sAdd
End If
End With
For Each rcell In HousesRange
Application.Goto rcell
Next rcell
End Sub