Friday 17 February 2017

Converting VBA 2-Dimensional vector to 1-Dimensional Array

Well, I would have like to have contributed to Stack Overflow's VBA Documentation, specifically an array example but that section is full!   So I will deposit the code here.

This code will take a vector, either a column vector or a row vector and convert to 1 dimensional array.  So to be precise, the vector is in fact a 2 dimensional variant array where either the number of rows is one or the number of columns is one.

This finding arose from an exchange of comments on a solution by yowe3k (http://stackoverflow.com/users/6535336/yowe3k).

Option Explicit
Option Private Module

Private Function ConvertColumnOrRowVectorToOneDimensionalArray(vVector As Variant) As Variant
    '* from an answer from yowe3k (http://stackoverflow.com/users/6535336/yowe3k) , transferred to documentation by S Meaden (http://stackoverflow.com/users/3607273/s-meaden)
    Const sERROR_MSG_CORE As String = "Please pass a 2d variant array with one dimension of one element size"
    
    If IsObject(vVector) Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "(you passed an object)!"  '* if you pass a Range, please pass Range.Value instead
    If Not IsArray(vVector) Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "!"
    
    Dim lColumnLBound As Long: lColumnLBound = LBoundOERN(vVector, 2)
    If lColumnLBound = -1 Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "(you passed a 1d array)!"

    If Not (UBound(vVector, 1) - LBound(vVector, 1) = 0 Or UBound(vVector, 2) - LBound(vVector, 2) = 0) Then Err.Raise vbObjectError, , "#" & sERROR_MSG_CORE & "(you passed a matrix)!"
    
    If UBound(vVector, 1) - LBound(vVector, 1) = 0 Then
        ConvertColumnOrRowVectorToOneDimensionalArray = Application.Transpose(Application.Transpose(vVector))
    Else
        ConvertColumnOrRowVectorToOneDimensionalArray = Application.Transpose(vVector)
    End If
    
End Function

Private Function LBoundOERN(v, n) As Long
    LBoundOERN = -1
    On Error Resume Next
    LBoundOERN = LBound(v, n)
End Function

'***************************************************************
'* TESTS - also illustrative as to how to call the function
'***************************************************************

Private Sub TestConvertColumnOrRowVectorToOneDimensionalArray_All()
    
    TestConvertColumnOrRowVectorToOneDimensionalArray_NonErrors
    TestConvertColumnOrRowVectorToOneDimensionalArrayTestErrorThrowing
End Sub

Private Sub TestConvertColumnOrRowVectorToOneDimensionalArray_NonErrors()
    
    
    Sheet1.Cells(1, 1) = "foo"  '* set up the data
    Sheet1.Cells(2, 1) = "bar"  '* in a vertical block of three
    Sheet1.Cells(3, 1) = "baz"  '* cells
    
    Dim v1DFromColumnVector
    v1DFromColumnVector = ConvertColumnOrRowVectorToOneDimensionalArray(Sheet1.Range("A1:A3").Value)
    Debug.Assert v1DFromColumnVector(1) = "foo"  '* now
    Debug.Assert v1DFromColumnVector(2) = "bar"  '* one-
    Debug.Assert v1DFromColumnVector(3) = "baz"  '* dimensional
    
    
    Sheet1.Cells(1, 3) = "foo"   '* set up the data
    Sheet1.Cells(1, 4) = "bar"   '* in a horizontal block of three
    Sheet1.Cells(1, 5) = "baz"   '* cells
    
    Dim v1DFromRowVector
    v1DFromRowVector = ConvertColumnOrRowVectorToOneDimensionalArray(Sheet1.Range("C1:E1").Value)
    
    Debug.Assert v1DFromRowVector(1) = "foo"    '* now
    Debug.Assert v1DFromRowVector(2) = "bar"    '* one-
    Debug.Assert v1DFromRowVector(3) = "baz"    '* dimensional
    
    
End Sub


Private Sub TestConvertColumnOrRowVectorToOneDimensionalArrayTestErrorThrowing()
    On Error Resume Next  '* On Error ... resets the error object and its properties
    Debug.Assert Err.Number = 0
    ConvertColumnOrRowVectorToOneDimensionalArray Sheet1.Cells(1, 1)
    Debug.Assert Err.Number = vbObjectError
    Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed an object)!"
    
    On Error Resume Next  '* On Error ... resets the error object and its properties
    Debug.Assert Err.Number = 0
    ConvertColumnOrRowVectorToOneDimensionalArray "FOO"
    Debug.Assert Err.Number = vbObjectError
    Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size!"
    
    On Error Resume Next  '* On Error ... resets the error object and its properties
    Dim vOneDim(1 To 3) As Variant
    vOneDim(1) = "luke": vOneDim(2) = "leia": vOneDim(3) = "han":
    ConvertColumnOrRowVectorToOneDimensionalArray vOneDim
    Debug.Assert Err.Number = vbObjectError
    Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed a 1d array)!"
    
    
    On Error Resume Next  '* On Error ... resets the error object and its properties
    Debug.Assert Err.Number = 0
    ConvertColumnOrRowVectorToOneDimensionalArray Sheet1.Range("A1:B2").Value
    Debug.Assert Err.Number = vbObjectError
    Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed a matrix)!"
    
    
    On Error Resume Next  '* On Error ... resets the error object and its properties
    Debug.Assert Err.Number = 0
    ConvertColumnOrRowVectorToOneDimensionalArray [{"Jonh","Snow","President";"Ygritte","Wild","Vice-President"}]
    Debug.Assert Err.Number = vbObjectError
    Debug.Assert Err.Description = "#Please pass a 2d variant array with one dimension of one element size(you passed a matrix)!"
    
    
End Sub

No comments:

Post a Comment