Looping through two unions of non-contiguous ranges

Question

Hi

I have two ranges [of equal size] filled with scatterd cells from several Excel Worksheets.

My aim is to copy the values from the cells in Union1 to [the correpsonding cell] in Union2.

A pseudo code for it would look like this:

---- alt 1 ----

Sub test1()
    Dim Union1 As Range, Union2 As Range, i As Long

    Set Union1 = Union(Range("C1"),Range("E12"),Range("G4"))
    Set Union2 = Union(Range("A3"),Range("F2"),Range("M43")) 

For i = 0 To [number of cells in Union1]
    Union2(i).Value = Union1(i).Value
Next

End Sub

---- alt 2 ----

Sub test2()
    Dim Union1 As Range, Union2 As Range, c As Range, d As Range

    Set Union1 = Union(Range("C1"),Range("E12"),Range("G4"))
    Set Union2 = Union(Range("A3"),Range("F2"),Range("M43")) 

    For Each c In Union1 and Each d in Union2
         d.Value = c.Value
   Next c, d
End Sub

Thanks
/Niklas

Answer 1

I've made an ugly solution to my problem where I use a tempory array to store the values in.

Private Function CopyMyRanges(Range1 As Range, Range2 As Range) As Boolean
   
    Dim c As Range, i As Long, tmparray() As Variant
    
    CopyMyRanges = False
   
    If Not Range1.Count = Range2.Count Then Exit Function
   
    ReDim tmparray(Range1.Count)
   
    i = 0
    For Each c In Range1
        tmparray(i) = c.Value
        i = i + 1
    Next c

    i = 0
    For Each c In Range2
        c.Value = tmparray(i)
        i = i + 1
    Next c

    CopyMyRanges = True
   
End Function

Answer 2

Each separate range of the Union is an Area and you work in the Areas of the Unions.

Sub test1()

Sub test1()

    Dim Union1 As Range
    Dim Union2 As Range
    Dim i As Long
    Dim j As Long
 
    Set Union1 = Union(Range("C1"), Range("E12"), Range("G4"))
    Set Union2 = Union(Range("A3"), Range("F2"), Range("M43"))
   
    For i = 1 To Union1.Areas.Count
        For j = 1 To Union1.Areas(i).Cells.Count
            Union2.Areas(i).Cells(j) = Union1.Areas(i).Cells(j)
        Next j
    Next i
   
 End Sub

---

Regards, OssieMac