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
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
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.