Function to Combine Array

Hi All,

Here is a function to combine an array columns in another array.

Private Function CombineArrayCol(ArrFirst As Variant, ArrAdd As Variant, ArrResult As Variant) As Boolean

       

      'Created By Rajan 4-July-2012

            

       '---------How to Use-------------------

       'Syntex

       'CombineArrayCol FirstArray ,SecondArray ,ResultArray

           

        '   FirstArray = FirstArray is in which second array need to be combine,Must have atleast on column and Multidimensional

        '   SecondArray = SecondArray is which need to combined with FirstArray,Must have atleast on column and Multidimensional

        '   ResultArray = ResultArray is in which combined array will be stored

        '

        ' This Function Return True if Operation is succesfull and False with NULL Result array if Operation is Not succeed

       

      Dim blnFlag As Boolean

     

      'Validating Array , IsArray

        If IsArray(ArrFirst) And IsArray(ArrAdd) Then    ' if Both Parameter is an Array

        'Both array must contain same Row Number

            If UBound(ArrFirst) = UBound(ArrAdd) Then

                ' Both Array must contain atleast One Column

                If UBound(ArrAdd, 2) < 0 Or UBound(ArrFirst, 2) < 0 Then

                    blnFlag = True

                    GoTo ExitEarly:

                    End If

            Else

                    blnFlag = True

                    GoTo ExitEarly:

                End If

        Else

            blnFlag = True

            GoTo ExitEarly:

        End If

           

    'Defining Row and Column in ResultArray

    ReDim ArrResult(LBound(ArrFirst) To UBound(ArrFirst), LBound(ArrFirst, 2) To (UBound(ArrFirst, 2) + UBound(ArrAdd, 2)))

   

    Dim lngRow As Long

    Dim lngCol As Long

    Dim lngRow2 As Long

    Dim lngCol3 As Long

   

    'Filling First Array in ResultArray

    For lngCol = LBound(ArrFirst, 2) To UBound(ArrFirst, 2)

        For lngRow = LBound(ArrFirst) To UBound(ArrFirst)

            ArrResult(lngRow, lngCol) = ArrFirst(lngRow, lngCol)

        Next lngRow

    Next lngCol

   

    lngCol = lngCol - 1

   

    'Filling Second Array in ResultArray

    For lngCol2 = LBound(ArrAdd) To UBound(ArrAdd, 2)

        For lngRow2 = LBound(ArrAdd) To UBound(ArrAdd)

            ArrResult(lngRow2, lngCol2 + lngCol) = ArrAdd(lngRow2, lngCol2)

        Next lngRow2

    Next lngCol2

ExitEarly:

      If blnFlag Then

        ArrResult = Null

        CombineArrayCol = False

      Else

        CombineArrayCol = True

      End If

End Function

'===============================================

'Test Macro

'===============================================

Sub MYTest()

   

    Dim Arr1

    Dim Arr2

    Dim Arr4

    Dim StartTime As String

    Dim StrEndTime As String

    Dim StartTime1 As String

    Dim StrEndTime1 As String

   

    Arr1 = Range("Range1")

    Arr2 = Range("Range2")

   

   

    StartTime = Time

    CombineArrayCol Arr1, Arr2, Arr3

    StrEndTime = Time

   

    StartTime1 = Now

    Range("rngOutput").Resize(UBound(Arr3), UBound(Arr3, 2)).Value = Arr3

    StrEndTime1 = Now

   

    MsgBox "Array Filling Time " & vbCrLf & _

          "Start Time = " & StartTime & vbCrLf & _

          "End Time  = " & StrEndTime & vbCrLf & vbCrLf & _

          "Range Filling Time " & vbCrLf & _

          "Start Time = " & StartTime1 & vbCrLf & _

          "End Time  = " & StrEndTime1 & vbCrLf

End Sub

Any Comment and suggestion to improve it would be highly appreciated

Thanks for reading : Rajan verma