Add a function to treat 1x1 ranges as an array, not a scalar value.

The Range.Value function does not consistently return a 2-D array. If
the range is a single cell, it returns just the value in that cell. When
initializing a Userform listbox, it needs to be an array, so this
function was born.
This commit is contained in:
PhilRunninger 2024-03-15 10:09:56 -04:00
parent a821f15c32
commit b10a3ac655
10 changed files with 36 additions and 9 deletions

View File

@ -617,4 +617,28 @@ Public Function IntersectsWith(Range1 As Range, Range2 As Range) As Boolean
IntersectsWith = Not Application.Intersect(Range1, Range2) Is Nothing
End Function
' Credit: https://stackoverflow.com/a/64563408/510067
Public Function RangeToArray(inputRange As Range) As Variant()
Dim size As Integer
Dim inputValue As Variant, outputArray() As Variant
' inputValue will either be an variant array for ranges with more than 1 cell
' or a single variant value for range will only 1 cell
inputValue = inputRange
On Error Resume Next
size = UBound(inputValue)
If Err.Number = 0 Then
RangeToArray = inputValue
Else
On Error GoTo 0
ReDim outputArray(1 To 1, 1 To 1)
outputArray(1, 1) = inputValue
RangeToArray = outputArray
End If
On Error GoTo 0
End Function

View File

@ -28,11 +28,11 @@ Private Sub cmdOK_Click()
End Sub
Public Sub Initialize(part As String, billTo As String, shipTo As String)
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.Value
cbPart.list = RangeToArray(shSupportingData.ListObjects("ITEM").DataBodyRange)
cbPart.Value = part
cbBill.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.Value
cbBill.list = RangeToArray(shSupportingData.ListObjects("CUSTOMER").DataBodyRange)
cbBill.Value = billTo
cbShip.list = shSupportingData.ListObjects("CUSTOMER").DataBodyRange.Value
cbShip.list = RangeToArray(shSupportingData.ListObjects("CUSTOMER").DataBodyRange)
cbShip.Value = shipTo
useval = False

View File

@ -315,7 +315,10 @@ Private Sub UserForm_Activate()
Next i
'-------------load tags-------------------------------
cbTAG.list = shConfig.ListObjects("TAGS").DataBodyRange.Value
cbTAG.list = RangeToArray(shConfig.ListObjects("TAGS").DataBodyRange)
If cbTAG.ListCount = 1 Then
cbTAG.ListIndex = 0
End If
'----------reset spinner buttons----------------------
sbpv.Value = 0

View File

@ -55,9 +55,9 @@ End Sub
Private Sub UserForm_Activate()
handler.server = shConfig.Range("server").Value
cbDSM.list = shSupportingData.ListObjects("DSM").DataBodyRange.Value
cbDirector.list = shConfig.ListObjects("DIRECTORS").DataBodyRange.Value
cbSegment.list = shConfig.ListObjects("SEGMENTS").DataBodyRange.Value
cbDSM.list = RangeToArray(shSupportingData.ListObjects("DSM").DataBodyRange)
cbDirector.list = RangeToArray(shConfig.ListObjects("DIRECTORS").DataBodyRange)
cbSegment.list = RangeToArray(shConfig.ListObjects("SEGMENTS").DataBodyRange)
End Sub

View File

@ -29,7 +29,7 @@ End Sub
Private Sub UserForm_Activate()
useval = False
cbPart.list = shSupportingData.ListObjects("ITEM").DataBodyRange.Value
cbPart.list = RangeToArray(shSupportingData.ListObjects("ITEM").DataBodyRange)
End Sub