CODEWITHSUNDEEP
arraysvbaexcel
Jacob Culleny
Jacob Culleny

Reputation: 21

Saving Multiple excel Ranges into a 2 dimensional array - not all at the same

Im writing an excel macro, that essentially analyzes a range of information (one row specifically), and if there are triplicates (3 or more of the same name in a row), it sets the range to red so it stands out. Now what i want to do is every time the program finds a triplicate range, it saves that range (3 rows by 8 columns) to an array. I understand how to save a single range into an array, but how do i add the next range that my program finds (and then the next range, thereafter). After the program runs and finds all triplicate ranges, I want it to take that 2-d array and paste all of the found data into an empty sheet.

    For k = 1 To LastRow - 1

                 '   If (k + 1 <= LastRow) Then

                    If (FunctionArray(k + 1) = FunctionArray(k)) Then
                        count = count + 1

                    ElseIf (count >= 3 And FunctionArray(k + 1) <> FunctionArray(k)) Then
                        StartPoint = k - (count - 2)
                        Range(Cells(StartPoint, 1), Cells(k + 1, 11)).Select
                        With Selection
                            .Font.Bold = True
                            .Font.Color = -16776961
                            .Borders(xlEdgeLeft).LineStyle = xlContinuous
                            .Borders(xlEdgeRight).LineStyle = xlContinuous
                            .Borders(xlEdgeBottom).LineStyle = xlContinuous
                            .Borders(xlEdgeTop).LineStyle = xlContinuous
                        End With



                        count = 1

                    ElseIf (count = 2 And FunctionArray(k + 1) <> FunctionArray(k)) Then
                        count = 1
                    End If


                Next k

If you look in the second IF statement, i already successfully wrote out the logic to find the desired range. i just need to save that information i find in a 2-d array and then continue to add the found ranges thereafter. Thank you for any help.

Upvotes: 1

Views: 652

Answers (1)

John Coleman
John Coleman

Reputation: 51998

If I read you right, you want to take a variable number of rectangular ranges and, ultimately, gather all of the values into a single 2-dimensional array that you can paste into a worksheet. One method is to create a collection of ranges, then feed them to a function which will gather them into a single array. The following code shows one possible function as well as a test sub to illustrate what it does. To test is -- put values into ranges "A1:C2" and "B4:C6" and then run the test sub:

Function compactify(ranges As Collection) As Variant
'assumes that ranges is a non-empty collection
'of rectangular ranges
    Dim i As Long, j As Long, m As Long, n As Long
    Dim block As Variant
    Dim r As Range, myRow As Range
    For Each r In ranges
        m = m + r.Rows.Count
        If r.Columns.Count > n Then n = r.Columns.Count
    Next r
    ReDim block(1 To m, 1 To n)
    For Each r In ranges
        For Each myRow In r.Rows
            i = i + 1
            For j = 1 To myRow.Columns.Count
                block(i, j) = myRow.Cells(1, j).Value
            Next j
        Next myRow
    Next r
    compactify = block
End Function

Sub test()
    Dim myRanges As New Collection
    myRanges.Add Range("A1:C2")
    myRanges.Add Range("B4:C6")
    Range("A10:C14").Value = compactify(myRanges)
End Sub

Upvotes: 2

Related Questions