• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Need help on

Here is a UDF that you can employ but you will need to change how your worksheet is arranged; your lookup values in your table range needs to be in the left most column of the data you are searching. Same as using the Vlookup function. Here is the code and I have attached your workbook changed to show the results.

Code: 
Option Explicit
Function VLookupMulti(ByVal strIndex As String, ByVal rng As Range, _
                      Optional ref As Integer = 1, Optional myJoin As String = " ", _
                      Optional myOrd As Boolean = True) As String
'
' jindon
' http://www.mrexcel.com/forum/showthread.php?t=344561&highlight=muvlookup
'
' =VLookUpMulti(A1, C1:D100, 2, ",", False)
'
    Dim a, b(), i As Long, n As Long
    a = rng.Value
    ReDim b(1 To UBound(a, 1), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a, 1)
            If a(i, 1) = strIndex Then
                If Not .exists(a(i, ref)) Then
                    .Add a(i, 2), Nothing
                    n = n + 1: b(n, 1) = a(i, 2)
                    b(n, 2) = IIf(IsNumeric(a(i, 2)), a(i, 2), UCase(a(i, 2)))
                End If
            End If
        Next
    End With
    VSortM b, 1, n, 2, False
    For i = 1 To n
        VLookupMulti = VLookupMulti & IIf(VLookupMulti = "", "", myJoin) & b(i, 1)
    Next
End Function

Sub VSortM(ary, lb, UB, ref, myOrd)
    Dim i As Long, ii As Long, iii As Long, m, temp
    i = UB: ii = lb
    m = ary(Int((lb + UB) / 2), ref)
    Do While ii <= i
        If myOrd Then
            Do While ary(ii, ref) < m: ii = ii + 1: Loop
            Do While ary(i, ref) > m: i = i - 1: Loop
        Else
            Do While ary(ii, ref) > m: ii = ii + 1: Loop
            Do While ary(i, ref) < m: i = i - 1: Loop
        End If
        If ii <= i Then
            For iii = LBound(ary, 2) To UBound(ary, 2)
                temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
            Next
            i = i - 1: ii = ii + 1
        End If
    Loop
    If lb < i Then VSortM ary, lb, i, ref, myOrd
    If ii < UB Then VSortM ary, ii, UB, ref, myOrd
End Sub
 

Attachments

  • Sample.xlsx
    11.1 KB · Views: 7
AlanSidman said:
Here is a UDF that you can employ but you will need to change how your worksheet is arranged; your lookup values in your table range needs to be in the left most column of the data you are searching. Same as using the Vlookup function. Here is the code and I have attached your workbook changed to show the results.

Code: 
Option Explicit
Function VLookupMulti(ByVal strIndex As String, ByVal rng As Range, _
                      Optional ref As Integer = 1, Optional myJoin As String = " ", _
                      Optional myOrd As Boolean = True) As String
'
' jindon
' http://www.mrexcel.com/forum/showthread.php?t=344561&highlight=muvlookup
'
' =VLookUpMulti(A1, C1:D100, 2, ",", False)
'
    Dim a, b(), i As Long, n As Long
    a = rng.Value
    ReDim b(1 To UBound(a, 1), 1 To 2)
    With CreateObject("Scripting.Dictionary")
        .CompareMode = vbTextCompare
        For i = 1 To UBound(a, 1)
            If a(i, 1) = strIndex Then
                If Not .exists(a(i, ref)) Then
                    .Add a(i, 2), Nothing
                    n = n + 1: b(n, 1) = a(i, 2)
                    b(n, 2) = IIf(IsNumeric(a(i, 2)), a(i, 2), UCase(a(i, 2)))
                End If
            End If
        Next
    End With
    VSortM b, 1, n, 2, False
    For i = 1 To n
        VLookupMulti = VLookupMulti & IIf(VLookupMulti = "", "", myJoin) & b(i, 1)
    Next
End Function

Sub VSortM(ary, lb, UB, ref, myOrd)
    Dim i As Long, ii As Long, iii As Long, m, temp
    i = UB: ii = lb
    m = ary(Int((lb + UB) / 2), ref)
    Do While ii <= i
        If myOrd Then
            Do While ary(ii, ref) < m: ii = ii + 1: Loop
            Do While ary(i, ref) > m: i = i - 1: Loop
        Else
            Do While ary(ii, ref) > m: ii = ii + 1: Loop
            Do While ary(i, ref) < m: i = i - 1: Loop
        End If
        If ii <= i Then
            For iii = LBound(ary, 2) To UBound(ary, 2)
                temp = ary(ii, iii): ary(ii, iii) = ary(i, iii): ary(i, iii) = temp
            Next
            i = i - 1: ii = ii + 1
        End If
    Loop
    If lb < i Then VSortM ary, lb, i, ref, myOrd
    If ii < UB Then VSortM ary, ii, UB, ref, myOrd
End Sub
Click to expand...

Sir,
Thanks a lot for your valuable time on this. This is what i was looking for but can we change the order of concatenate to reverse?

Now, from lower to high position.
 
You must log in or register to reply here.
Back
Top