MS VBA with loops and unions

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