Excel VBA, combine 2 sets of data into a single array and remove blank rows

Question

I've been using stackoverflow as a great reference tool for VBA.

I've got 2, 2-column sets of data as shown below.

My goal is to have a user input data into those 2 columns, create a single 2-column array with that info, and remove blank rows from that array, and then create a drop-down containing the info from the first column of the combined array. The second column will be used for voltage references. (the header not being part of the array.)

What i've done is create 2 arrays at first, and combine them. I'm not sure if this is the best method, I need something that will work fast and I'm not sure how to properly remove the rows. The code is below:

Sub test1()
    Dim CombinedArray As Variant
    Dim SWGRArray As Variant
    Dim MCCArray As Variant 
    SWGRArray = Sheets("Worksheet").Range(Cells(3, 8), Cells(19, 9)).value
    MCCArray = Sheets("Worksheet").Range(Cells(3, 10), Cells(19, 11)).value
    CombinedArray = MergeArrays(SWGRArray, MCCArray)
End Sub
Public Function MergeArrays(ParamArray Arrays() As Variant) As Variant
' merges multiple arrays into a single array.
' ParamArray is an array listing other arrays
' Thanks to 'Tom' via https://stackoverflow.com/questions/46051448/excel-vba-joining-two-arrays
    Dim i As Long, J As Long, cnter As Long, UBoundArr As Long, OldUBoundArray As Long
    Dim arr() As Variant
    For J = LBound(Arrays) To UBound(Arrays)
        UBoundArr = UBoundArr + UBound(Arrays(J), 1)
    Next J
    ReDim arr(1 To UBoundArr, 1 To 1)
    For J = LBound(Arrays) To UBound(Arrays)
        For i = LBound(Arrays(J)) To UBound(Arrays(J))
            arr(i + OldUBoundArray, 1) = Arrays(J)(i, 1)
        Next i
        OldUBoundArray = OldUBoundArray + UBound(Arrays(J), 1)
    Next J
    MergeArrays = arr
End Function

score 0 · Accepted Answer · answered Jun 30 '20 at 20:11

Stack Arrays

I was about to post this on the 16th, when right in front of my nose the post got deleted. So I'm sorry there are no comments, it was a long time ago.

Option Explicit

Function getStackedArrays(ByVal FirstIndex As Long, _
                            ParamArray Arrays() As Variant) _
                As Variant
    ' Define Lower-Upper Array.
    Dim UB As Long: UB = UBound(Arrays)
    Dim LU As Variant: ReDim LU(3)
    Dim lub As Variant
    Dim i As Long
    For i = 0 To 3: ReDim lub(0 To UB): LU(i) = lub: Next i
    
    ' Populate Lower-Upper Array and calculate dimensions of Result Array.
    Dim uCount As Long, uCurr As Long
    Dim lMax As Long, lCurr As Long
    For i = 0 To UB
        If IsArray(Arrays(i)) Then
            GoSub calcIsArray
        Else
            GoSub calcNotArray
        End If
        GoSub countnMax
    Next i
    If lMax = 0 Or uCount = 0 Then Exit Function
    
    ' Define Result Array.
    Dim UB1 As Long: UB1 = FirstIndex + uCount - 1
    Dim UB2 As Long: UB2 = FirstIndex + lMax - 1
    Dim Result As Variant: ReDim Result(FirstIndex To UB1, FirstIndex To UB2)
    
    ' Populate Result Array.
    Dim k As Long, l As Long, m As Long, n As Long
    m = FirstIndex
    For i = 0 To UB
        If IsArray(Arrays(i)) Then
            GoSub writeResult
        End If
    Next i
                        
    ' Write Result Array to Function Result.
    getStackedArrays = Result

Exit Function

' Subroutines
calcIsArray:
    If LBound(Arrays(i)) <= UBound(Arrays(i)) Then
        LU(0)(i) = LBound(Arrays(i)): LU(1)(i) = UBound(Arrays(i))
        On Error Resume Next
        LU(3)(i) = LBound(Arrays(i), 2): LU(3)(i) = UBound(Arrays(i), 2)
        On Error GoTo 0
    End If
    Return

calcNotArray:
    If Not IsEmpty(Arrays(i)) Then
        ReDim lub(0): lub(0) = Arrays(i): Arrays(i) = lub
        LU(0)(i) = 0: LU(1)(i) = 0
    End If
    Return

countnMax:
    uCurr = LU(1)(i) - LU(0)(i) + 1: uCount = uCount + uCurr
    On Error Resume Next
    lCurr = LU(3)(i) - LU(2)(i) + 1
    If lCurr > lMax Then lMax = lCurr
    On Error GoTo 0
    Return

writeResult:
    If Not IsEmpty(LU(0)(i)) And Not IsEmpty(LU(2)(i)) Then   ' 2D
        For k = LU(0)(i) To LU(1)(i)
            n = FirstIndex
            For l = LU(2)(i) To LU(3)(i)
                Result(m, n) = Arrays(i)(k, l)
                n = n + 1
            Next l
            m = m + 1
        Next k
    Else                          ' 1D
        For k = LU(0)(i) To LU(1)(i)
            Result(m, FirstIndex) = Arrays(i)(k)
            m = m + 1
        Next k
    End If
    Return

End Function

Excel VBA, combine 2 sets of data into a single array and remove blank rows

1 Answers1

Stack Arrays