Sort/Array function

[pwwato]

Hi All

Thanks for looking at this and any input given.

I have created a function that creates an 2D array of a worksheet (TArray) and then sorts thru that data and finds the requested criteria in this case a reference number.
once all references are found it creates another array (Temparray) and puts these references and there corresponding rows into this new array.

The object of this is to populate a userform combobox with this list the function works fine and populates the combobox correctly but I still have a few issues that I would appreciate some help on. here is the code.

Public Function create_array(TBook As String, TSheet As String, ByRef TRange As Range, TMatch As String, DO2T As Integer, ByRef TArray As Variant) As Variant

Dim lastrow As String

    Application.ScreenUpdating = False
    Application.Workbooks(TBook).Sheets(TSheet).Activate
With ActiveSheet
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

If DO2T = 1 Then
    .UsedRange.Select
Set TRange = Selection.CurrentRegion
    TArray = TRange.Value
    Application.Workbooks(TBook).Sheets(TSheet).Range("A1").Select
        
        
ElseIf DO2T = 2 Then

Set TRange = TRange.Resize(lastrow, TRange.Columns.Count)
    TArray = TRange
    
ElseIf DO2T = 3 Then

Set TRange = TRange.Resize(lastrow, TRange.Columns.Count)
    TArray = TRange
    
Dim matchArrIndex As Variant, splitArr As Variant
Dim i As Integer, outerindex As Integer, innerIndex As Integer, tempArrayIndex As Integer, CurrIndex As Integer, stringLength As Integer, MType As Variant
Dim increaseIndex As Boolean
Dim actualStr As String

    splitArr = Split(TMatch, "*")
On Error GoTo errorHandler
If UBound(splitArr) = 0 Then
    MType = 0 'Exact Match
    actualStr = TMatch
ElseIf UBound(splitArr) = 1 And splitArr(1) = "" Then
    MType = 1 'Starts With
    actualStr = splitArr(0)
ElseIf UBound(splitArr) = 1 And splitArr(0) = "" Then
    MType = 2 'ends With
    actualStr = splitArr(1)
ElseIf UBound(splitArr) = 2 And splitArr(0) = "" And splitArr(2) = "" Then
    MType = 3 'contains
    actualStr = splitArr(1)
Else
    MsgBox "Incorrect match provided"
Exit Function
End If
'start index
    i = LBound(TArray, 1)
'resize array for matched values
ReDim matchArrIndex(LBound(TArray, 1) To UBound(TArray, 1)) As Variant
'outer loop
For outerindex = LBound(TArray, 1) To UBound(TArray, 1)
'inner loop
For innerIndex = LBound(TArray, 2) To UBound(TArray, 2)
'if string matches with array elements
If (MType = 0 And TArray(outerindex, innerIndex) = actualStr) Then
'Or _
    (MType = 1 And Left(TArray(outerindex, innerIndex), Len(actualStr)) = actualStr) Or _
    (MType = 2 And Right(TArray(outerindex, innerIndex), Len(actualStr)) = actualStr) Or _
    (MType = 3 And InStr(TArray(outerindex, innerIndex), actualStr) <> 0) Then
    increaseIndex = True
    matchArrIndex(i) = outerindex
End If
Next
    If increaseIndex Then
    tempArrayIndex = tempArrayIndex + 1
    increaseIndex = False
    i = i + 1
End If
Next
'if no matches found, exit the function
If tempArrayIndex = 0 Then
Exit Function
End If
If LBound(TArray, 1) = 0 Then
    tempArrayIndex = tempArrayIndex - 1
End If
'resize temp array
ReDim temparray(LBound(TArray, 1) To tempArrayIndex, LBound(TArray, 2) To UBound(TArray, 2)) As Variant
    CurrIndex = LBound(TArray, 1)
Dim j As Integer
    j = LBound(matchArrIndex)
'store values in temp array
For i = CurrIndex To UBound(temparray)
For innerIndex = LBound(TArray, 2) To UBound(TArray, 2)
    temparray(i, innerIndex) = TArray(matchArrIndex(j), innerIndex)
Next
    j = j + 1
Next
    TArray = temparray
Exit Function
errorHandler:
    MsgBox "Error :" & Err.Description

End If
End With
End Function

The difficulties i am having are

1, the data on the original worksheet the array is made from randomly get changed when this function is run or at least the rows with the criteria required are but not all cell data is changed only parts?

2, it never works on the first attempt (returns empty array) but always works from then on?

3, is there a way to only look for the matching criteria in column 1 of the original array (TArray) and return the coresponding row data rather than looking thu the whole array.

4 and is there away to take the final array (Temparray) and remove certain columns before showing in the list eg i only want to display in combobox list columns 2-5

Hope some one can help!!!
​

 

[pwwato]

Ok so sorted so far
1 copied orginal worksheet to temp and used this to create the TArray, works not sure if there is a better way?

2 after creating the temp worksheet problem with first attempt failure resolved? not sure why

3 not sorted yet .

4. cleared contents of temp worksheet repopulated with TAarray and then reset tarray to the range of columns req using the temp sheet, before deleting temp worksheet. works ok

im sure there is an easier way of doing this but atleast its working well enough to move on , but any help would be appreciated if there is an easier way.