Thread: Sequence Function

'Ello everyone,

New to the forums and to VBA; however, I am trying to write a function that takes a row of data, and generates a cell with the sequence of how the data occurred with the lowest data value being the starting index (#1, then #2 would be the next highest, and so forth).

The function I'm trying to create:
Takes a row of data with several columns (not every column has numbers),
Removes the duplicates,
Sorts from low to high then assigns each number an index number (1...n),
Then displays an one cell output matching the index number up with the original row's occurrence..


Example:
Original row: 1234.45, 4567.123, 5678.45, 453.23, 3213.12, 1234.45, 4567.123

(internal function information, not to be displayed)
Unique numbers: 453.23,1234.45, 3213.12, 4567.123, 5678.45
Index: 1, 2, 3, 4, 5


(output to be displayed)
Final Result: 2-4-5-1-3-2-4

^ This is how the the data occurred in the row.


I've already attempted to try and create my own little VBA function but unfortunately at this is my first try I am struggling heavily. I can't seem to figure out how to even get the selected row to remove the duplicate numbers.

Function UniqueItems(Nums As Variant)

    ' can't figure out how to get the UBound to work properly w/o transpose
    
    Dim UB As Integer
    Dim LB As Integer
    
    UB = UBound(Application.Transpose(Nums), 1)
    LB = LBound(Application.Transpose(Nums), 1)
    
    ' Unique() = Unique Values
    
    ' User can only have 1 row selected at a time, ~infinite amount of columns.

    If Application.Caller.Rows.Count > 1 Then
        UniqueItems = CVErr(xlErrRef)
        Exit Function
    End If
    
    ' Setup some array, variables
    Dim Unique() As Variant
    Dim N As Integer
    Dim P As Integer
    Dim Nbr As Integer
    P = 0
    ReDim Unique(P)
    
    ' not sure what exactly I am donig here but its cool.
    
    For N = 1 To UB
        Nbr = Nums(N)
        If WorksheetFunction.IsNumber(Nbr) = True Then
            If Unique(0) = "" Then
                Unique(0) = Nbr
            Else
                If WorksheetFunction.Match(Nbr, Unique, 0) = "" Then
                    ReDim Preserve Unique(P)
                    Unique(P) = Nbr
                End If
            End If
            P = P + 1
        Else
            UniqueItems = CVErr(xlErrNum)
            Exit Function
        End If
    Next N
    

    UB = UBound(Application.Transpose(Unique), 1)
    LB = LBound(Application.Transpose(Unique), 1)
    
    ' Display the end result
    ' Saddly, I can't get anything to work.
    
    
    UniqueItems = Unique(1)
    ' The output doesn't work.... nothing is stored in unique 1.
     

End Function

I'm looking for just general help. I'm a complete VBA newb and i'm not sure even I'm even pursing this the best way.

Hi, and welcome to the forum. I'll try and help you out with this, but I need to start with a question.

This...

Originally Posted by gpx6

Removes the duplicates

Doesn't match this ...

Originally Posted by gpx6

(output to be displayed)
Final Result: 2-4-5-1-3-2-4

If you're removing the duplicates how can you have the same index number returned twice? Which way round do you want it - with duplicates or without?

Anyway, while you think on that have a look at this, which is nearly, but not quite, what you're after ...

Function Sequence(rngSourceRange As Range, Optional sDelimiter = "-") As String

Dim sTmpReturn As String
Dim rngLoop As Range
Dim lRank As Long

sTmpReturn = "-"

For Each rngLoop In rngSourceRange.Cells
  If IsNumeric(rngLoop.Value) And rngLoop.Value <> "" Then
    lRank = WorksheetFunction.Rank(rngLoop.Value, rngSourceRange, 1)
    sTmpReturn = sTmpReturn & Trim(Str(lRank)) & "-"
    End If
Next rngLoop


If Len(sTmpReturn) > 1 Then
  sTmpReturn = Mid(sTmpReturn, 2, Len(sTmpReturn) - 2)
  sTmpReturn = Replace(sTmpReturn, "-", sDelimiter)
Else
  sTmpReturn = ""
End If

Sequence = sTmpReturn

End Function

I have one more question... I am having a problem. I tried modifying the VBA script to take the information (copied the for each rngLoop), truncating that data to 1 number past the decimal point, then finding the rank of each cell (truncated to #.x as well) versus the newly truncated data.

Unfortunately, I am not a pro at this whatsoever.


Example of what I'm trying to do:

row: 123.23, 456.56, 789.98, 123.25, 456.69, 789.75

Would like to give the sequence based on truncated numbers instead of the whole numbers. As the above example would give a sequence of:

1-3-6-2-4-5

Where as by using truncated data ( to ###.x) , It would return what a more fitting sequence of:

1-2-3-1-2-3

I tried to put all the truncated data into a single array but that hasn't worked yet. I figured I would need to modify:

lRank = Worksheetfunction.Rank(WorksheetFunction.Trunc(rngLoop.Value,1), rngSourceRange, 1)