For the millionth time...I need a bit of assistance with sorting of an array.

[OaklandJim]

I am trying to assist another list user with a pretty arcane need. Thanx a billion for assisting.

I have the main infrastructure of the workbook built but I have not been able to get the logic right for the sort of an array. My array has three values for each entry. They are: 1. the digit being processed, 2. the first occurrence of the digit in a specified range of values and 3. the second occurrence of the digit in the same specified range of values. There are three digits to process so the array is 3 x 3. The sort on the array is done using the second value in the entries (the first occurrence of the digit in a specified range of values). All values are integer (type long).

Here is the workbook with a call to the function in Sheet2: WORKBOOK

Below is the function that I am trying to develop. It is the module named Func_GetOrderOfAppearance. It is working up to the point of the sort. I normally write "fluffy" code with lots of comments so 1. if I have to use the code later it'll be understandable and/or 2. if I give it to a list user I want her to be able to understand the code. This is no exception.

Option Explicit

Function GetOrderOfAppearance( _
    ByVal prRangeWithDigits As Range, _
    ByVal prRangeToLookIn As Range) As Long

'   Count of columns containing digits.
    Dim iDigitsCount As Long
   
'   Used to iterate through the values in the aiRaw array.
    Dim iDigitLoop As Long
   
'   Used to iterate through the values in the aiRaw array to sort it.
    Dim iDigitLoopInner As Long

'   The digit being processed.
    Dim iDigitValue As Long
   
'   The first occurrence of the digit within the "look in" data range.
    Dim iFirstAppearance As Long
      
'   The second occurrence of the digit within the "look in" data range.
    Dim iSecondAppearance As Long
      
    GetOrderOfAppearance = 0
   
 '  Count of columns in the data to process.
    iDigitsCount = prRangeWithDigits.Columns.Count

'   Do sizing for the array containing raw data directly from the "look in" data (range)
    ReDim aiRaw(1 To iDigitsCount, iDigitsCount)

'   Do sizing for the array containing sorted data in the aiRaw array.
    ReDim aiInOrder(1 To iDigitsCount, iDigitsCount)

'   Load the aiRaw array with 1. the digit 2. the first occurrence of the
'   digit in the "look in" data (range) and 3. the second occurrence of
'   the digit in the "look in" data (range)
   
    For iDigitLoop = 1 To iDigitsCount
   
'       Get the digit to be processed.
        iDigitValue = prRangeWithDigits.Cells(1, iDigitLoop).Value
       
'       Load the digit being processed into the array
        aiRaw(1, iDigitLoop) = iDigitValue

'       Load the first occurence of the digit in the "look in" data range
        aiRaw(2, iDigitLoop) = FindValueFirstOccurrence(iDigitValue, prRangeToLookIn)

'       Load the second occurence of the digit in the "look in" data range
        aiRaw(3, iDigitLoop) = FindValueSecondOccurrence(iDigitValue, prRangeToLookIn)

    Next

'    For iDigitLoop = 1 To iDigitsCount
'
'        Debug.Print
'        Debug.Print aiRaw(1, iDigitLoop)
'        Debug.Print aiRaw(2, iDigitLoop)
'        Debug.Print aiRaw(3, iDigitLoop)
''
'    Next iDigitLoop

'
    For iDigitLoop = 1 To iDigitsCount

        iDigitValue = aiRaw(1, iDigitLoop)

        iFirstAppearance = aiRaw(2, iDigitLoop)

        iSecondAppearance = aiRaw(3, iDigitLoop)

        For iDigitLoopInner = 1 To iDigitsCount
       
            If iFirstAppearance >= aiRaw(2, iDigitLoopInner) _
             Then

                If iDigitLoopInner < iDigitsCount _
                 Then
                    aiInOrder(1, iDigitLoopInner + 1) = aiRaw(1, iDigitLoopInner)
                    aiInOrder(2, iDigitLoopInner + 1) = aiRaw(2, iDigitLoopInner)
                    aiInOrder(3, iDigitLoopInner + 1) = aiRaw(3, iDigitLoopInner)
                End If

                aiInOrder(1, iDigitLoopInner) = iDigitValue
                aiInOrder(2, iDigitLoopInner) = iFirstAppearance
                aiInOrder(3, iDigitLoopInner) = iSecondAppearance

            End If

        Next
'
    Next iDigitLoop
   
'    For iDigitLoop = 1 To iDigitsCount
'
'        Debug.Print
'        Debug.Print aiInOrder(1, iDigitLoop)
'        Debug.Print aiInOrder(2, iDigitLoop)
'        Debug.Print aiInOrder(3, iDigitLoop)
''
'    Next iDigitLoop

End Function

 

[kevin9999]

Not exactly what you're looking for I know, but an alternative that I think might give you the same end result?

Option Explicit
Sub Alternative_Way()
    Dim Ws As Worksheet
    Set Ws = Worksheets("Sheet2")
    Dim rng As Range, r As Range, x As Range, i As Long
    Set rng = Ws.Range("B3:D15")
    Set r = Ws.Range("B2:D2")
    Set x = Ws.Range("G2:I2")
    
    For i = 1 To 3
        x.Cells(1, i) = Application.Min(WorksheetFunction.Match(r(1, i), rng.Columns(1), 0), _
        WorksheetFunction.Match(r(1, i), rng.Columns(2), 0), _
        WorksheetFunction.Match(r(1, i), rng.Columns(3), 0))
    Next i
    
    x.Sort key1:=x.Cells(1, 1), order1:=xlAscending, Orientation:=xlLeftToRight
End Sub

Before:

Values -- Row and Column Lookup suggestion.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N
1	C1	C2	C3			1st Column Where Value is Found			Last Column		Result Sought
2	5	8	5						0		1	2	2
3	11	8	0	1
4	5	5	4	2
5	7	7	0	3
6	0	0	0	4
7	1	1	1	5
8	2	2	2	6
9	3	3	3	7
10	4	4	4	8
11	5	5	5	9
12	6	6	6	10
13	7	7	7	11
14	8	8	8	12
15	9	9	9	13
Sheet2

Cell Formulas
Range	Formula
J2	J2	=MAX($G$2:$I$2)

Cells with Data Validation
Cell	Allow	Criteria
B2:D2	Whole number	between 0 and MAX($B$3:$D$15)

After:

Values -- Row and Column Lookup suggestion.xlsm
	B	C	D	E	F	G	H	I	J	K	L	M	N
1	C1	C2	C3			1st Column Where Value is Found			Last Column		Result Sought
2	5	8	5			1	2	2	2		1	2	2
3	11	8	0	1
4	5	5	4	2
5	7	7	0	3
6	0	0	0	4
7	1	1	1	5
8	2	2	2	6
9	3	3	3	7
10	4	4	4	8
11	5	5	5	9
12	6	6	6	10
13	7	7	7	11
14	8	8	8	12
15	9	9	9	13
Sheet2

Cell Formulas
Range	Formula
J2	J2	=MAX($G$2:$I$2)

Cells with Data Validation
Cell	Allow	Criteria
B2:D2	Whole number	between 0 and MAX($B$3:$D$15)

 

[Herakles]

I am trying to assist another list user with a pretty arcane need. Thanx a billion for assisting.

I have the main infrastructure of the workbook built but I have not been able to get the logic right for the sort of an array. My array has three values for each entry. They are: 1. the digit being processed, 2. the first occurrence of the digit in a specified range of values and 3. the second occurrence of the digit in the same specified range of values. There are three digits to process so the array is 3 x 3. The sort on the array is done using the second value in the entries (the first occurrence of the digit in a specified range of values). All values are integer (type long).

Here is the workbook with a call to the function in Sheet2: WORKBOOK

Below is the function that I am trying to develop. It is the module named Func_GetOrderOfAppearance. It is working up to the point of the sort. I normally write "fluffy" code with lots of comments so 1. if I have to use the code later it'll be understandable and/or 2. if I give it to a list user I want her to be able to understand the code. This is no exception.

Option Explicit

Function GetOrderOfAppearance( _
    ByVal prRangeWithDigits As Range, _
    ByVal prRangeToLookIn As Range) As Long

'   Count of columns containing digits.
    Dim iDigitsCount As Long
  
'   Used to iterate through the values in the aiRaw array.
    Dim iDigitLoop As Long
  
'   Used to iterate through the values in the aiRaw array to sort it.
    Dim iDigitLoopInner As Long

'   The digit being processed.
    Dim iDigitValue As Long
  
'   The first occurrence of the digit within the "look in" data range.
    Dim iFirstAppearance As Long
     
'   The second occurrence of the digit within the "look in" data range.
    Dim iSecondAppearance As Long
     
    GetOrderOfAppearance = 0
  
 '  Count of columns in the data to process.
    iDigitsCount = prRangeWithDigits.Columns.Count

'   Do sizing for the array containing raw data directly from the "look in" data (range)
    ReDim aiRaw(1 To iDigitsCount, iDigitsCount)

'   Do sizing for the array containing sorted data in the aiRaw array.
    ReDim aiInOrder(1 To iDigitsCount, iDigitsCount)

'   Load the aiRaw array with 1. the digit 2. the first occurrence of the
'   digit in the "look in" data (range) and 3. the second occurrence of
'   the digit in the "look in" data (range)
  
    For iDigitLoop = 1 To iDigitsCount
  
'       Get the digit to be processed.
        iDigitValue = prRangeWithDigits.Cells(1, iDigitLoop).Value
      
'       Load the digit being processed into the array
        aiRaw(1, iDigitLoop) = iDigitValue

'       Load the first occurence of the digit in the "look in" data range
        aiRaw(2, iDigitLoop) = FindValueFirstOccurrence(iDigitValue, prRangeToLookIn)

'       Load the second occurence of the digit in the "look in" data range
        aiRaw(3, iDigitLoop) = FindValueSecondOccurrence(iDigitValue, prRangeToLookIn)

    Next

'    For iDigitLoop = 1 To iDigitsCount
'
'        Debug.Print
'        Debug.Print aiRaw(1, iDigitLoop)
'        Debug.Print aiRaw(2, iDigitLoop)
'        Debug.Print aiRaw(3, iDigitLoop)
''
'    Next iDigitLoop

'
    For iDigitLoop = 1 To iDigitsCount

        iDigitValue = aiRaw(1, iDigitLoop)

        iFirstAppearance = aiRaw(2, iDigitLoop)

        iSecondAppearance = aiRaw(3, iDigitLoop)

        For iDigitLoopInner = 1 To iDigitsCount
      
            If iFirstAppearance >= aiRaw(2, iDigitLoopInner) _
             Then

                If iDigitLoopInner < iDigitsCount _
                 Then
                    aiInOrder(1, iDigitLoopInner + 1) = aiRaw(1, iDigitLoopInner)
                    aiInOrder(2, iDigitLoopInner + 1) = aiRaw(2, iDigitLoopInner)
                    aiInOrder(3, iDigitLoopInner + 1) = aiRaw(3, iDigitLoopInner)
                End If

                aiInOrder(1, iDigitLoopInner) = iDigitValue
                aiInOrder(2, iDigitLoopInner) = iFirstAppearance
                aiInOrder(3, iDigitLoopInner) = iSecondAppearance

            End If

        Next
'
    Next iDigitLoop
  
'    For iDigitLoop = 1 To iDigitsCount
'
'        Debug.Print
'        Debug.Print aiInOrder(1, iDigitLoop)
'        Debug.Print aiInOrder(2, iDigitLoop)
'        Debug.Print aiInOrder(3, iDigitLoop)
''
'    Next iDigitLoop

End Function

When having to do a sort such as this I often write the data to a worksheet, which is where it probably came from in the first place, and use an Excel Sort and then read the data
back into the array again.

I always know that it will work and one can write a flexible UDF to do it that can be used for other applications,

 

[kevin9999]

Another option to play with...

Option Explicit
Sub Alternative_Way_2()
    Dim Ws As Worksheet
    Set Ws = Worksheets("Sheet2")
    Ws.Range("G2:I2").ClearContents
    Dim a, b, c, i As Long, j As Long, k As Long, x
    a = Ws.Range("B2:D2")
    b = Ws.Range("B3:D15")
    c = Ws.Range("G2:I2")
    For i = 1 To 3
        x = a(1, i)
        For j = 1 To UBound(b, 1)
            For k = 1 To UBound(b, 2)
                If b(j, k) = x Then
                    c(1, i) = j
                    GoTo skip
                End If
            Next k
        Next j
skip:
    Next i
    Ws.Range("G2").Resize(1, 3).Value = c
    Ws.Range("G2:I2").Sort key1:=Ws.Range("G2"), order1:=xlAscending, Orientation:=xlLeftToRight
End Sub