• 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.

Return Multiple Values horizontally

Hii all

Please help in getting the multiple values horizontally which matches a criterion. My data base is Column A and B. The search value if in column G and the search returns multiple results which matches in column A. Sample sheet is attached herewith

Appreciate your help

Regards
 

Attachments

  • multiple match horizontally.xlsx
    13.7 KB · Views: 55
In H2
=IFERROR(INDEX($A$1:$B$9,SMALL(IF($A$1:$A$9=$G2,ROW($A$1:$A$9)),COLUMN(A1)),2),"")
confirm with Ctrl+Shift+Enter(array formula entry)
then copy right + down.

You need to clean the data in A2:A4.
 
Thanks for the response.. m using the same index and match combi but being an array formula it becomes very slow. I am working on 90000 rows.

So I was looking for the code which could work faster

Regards
 
Then
Code:
Sub test()
    Dim a, i As Long, ii As Long, w
    a = Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
        For i = 2 To UBound(a, 1)
            If Not .exists(a(i, 1)) Then
                .Item(a(i, 1)) = Array(.Count + 2, 2)
                For ii = 1 To 2
                    a(.Item(a(i, 1))(0), ii) = a(i, ii)
                Next
            Else
                w = .Item(a(i, 1))
                w(1) = w(1) + 1
                If w(1) > UBound(a, 2) Then
                    ReDim Preserve a(1 To UBound(a, 1), 1 To w(1))
                End If
                a(w(0), w(1)) = a(i, 2): .Item(a(i, 1)) = w
            End If
        Next
        i = .Count + 1
    End With
    With [g1].Resize(i, UBound(a, 2))
        .CurrentRegion.ClearContents
        .Value = a
        If .Columns.Count > 2 Then
            With .Cells(1, 2)
                .Value = .Value & 1
                .AutoFill .Resize(, UBound(a, 2) - 1)
            End With
        End If
    End With
End Sub
 
You only need the values already in col.G?

My result should look like

CustID Product1 Product2 Product3
002 xyz abc mmm
003 def hhh
004 yyy
005 fff
006 kkk
 
Sir In column G the unique values are getting reflected and in adjacent cells the matches values are appearing. It is working fine. But in Col G it is the search criterion and i want to search for only few cust IDs from the list appearing in Column A.

Regards
 
Change to
Code:
Sub test()
    Dim a, b, c, i As Long, ii As Long, t As Long
    a = Cells(1).CurrentRegion.Value
    With [g1].CurrentRegion
        b = .Value: ReDim c(1 To UBound(b, 1))
        t = UBound(b, 2)
        For i = 2 To UBound(b, 1)
            For ii = 2 To UBound(a, 1)
                If b(i, 1) = a(ii, 1) Then
                    c(i) = c(i) + 1
                    If UBound(b, 2) < c(i) + 1 Then
                       ReDim Preserve b(1 To UBound(b, 1), 1 To c(i) + 1)
                    End If
                    b(i, c(i) + 1) = a(ii, 2)
                End If
        Next ii, i
        With .Resize(, UBound(b, 2))
            .Value = b
            If UBound(b, 2) > t Then
                .Cells(1, t).AutoFill .Cells(1, t).Resize(, UBound(b, 2) - t + 1)
            End If
        End With
    End With
End Sub
Or just
Code:
Sub test()
    Dim r As Range, x
    For Each r In Range("g2", Range("g" & Rows.Count).End(xlUp))
        x = Filter(Evaluate("transpose(if(a1:a100000=" & r.Address & ",b1:b100000))"), False, 0)
        If UBound(x) > -1 Then r(, 2).Resize(, UBound(x) + 1) = x
    Next
End Sub
 
Last edited:
Hi !​
The search value if in column G and the search returns multiple results which matches in column A.
Working with exact ID in column A :​
Code:
Sub Demo()
    With Sheet1.Cells(7).CurrentRegion.Rows
        With .Item(2).Resize(.Count - 1).Columns
            VR = .Item(1).Value
            .Item(2).Resize(, .Count - 1).ClearContents
        End With
    End With
        VA = Sheet1.Cells(1).CurrentRegion.Value
    With CreateObject("Scripting.Dictionary")
            For Each V In VR:  .Item(V) = "":  Next
        For R& = 2 To UBound(VA)
            If .Exists(VA(R, 1)) Then .Item(VA(R, 1)) = .Item(VA(R, 1)) & VA(R, 2) & vbTab
        Next
            VA = Application.Transpose(.Items)
            .RemoveAll
    End With
         Application.DisplayAlerts = False
    With Sheet1.[H2].Resize(UBound(VA))
        .Value = VA
        .TextToColumns Tab:=True
    End With
         Application.DisplayAlerts = True
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
Change to
Code:
Sub test()
    Dim a, b, c, i As Long, ii As Long, t As Long
    a = Cells(1).CurrentRegion.Value
    With [g1].CurrentRegion
        b = .Value: ReDim c(1 To UBound(b, 1))
        t = UBound(b, 2)
        For i = 2 To UBound(b, 1)
            For ii = 2 To UBound(a, 1)
                If b(i, 1) = a(ii, 1) Then
                    c(i) = c(i) + 1
                    If UBound(b, 2) < c(i) + 1 Then
                       ReDim Preserve b(1 To UBound(b, 1), 1 To c(i) + 1)
                    End If
                    b(i, c(i) + 1) = a(ii, 2)
                End If
        Next ii, i
        With .Resize(, UBound(b, 2))
            .Value = b
            If UBound(b, 2) > t Then
                .Cells(1, t).AutoFill .Cells(1, t).Resize(, UBound(b, 2) - t + 1)
            End If
        End With
    End With
End Sub
Or just
Code:
Sub test()
    Dim r As Range, x
    For Each r In Range("g2", Range("g" & Rows.Count).End(xlUp))
        x = Filter(Evaluate("transpose(if(a1:a100000=" & r.Address & ",b1:b100000))"), False, 0)
        If UBound(x) > -1 Then r(, 2).Resize(, UBound(x) + 1) = x
    Next
End Sub

Hi,

That smaller VBA code works a treat, awesome!!!

How can I reference the same ranges but from another sheet in the same workbook.

Example in the line below

x = Filter(Evaluate("transpose(if(a1:a100000=" & r.Address & ",b1:b100000))"), False, 0)

Thanks very much in advance
 
Hi,

That smaller VBA code works a treat, awesome!!!

How can I reference the same ranges but from another sheet in the same workbook.

Example in the line below

x = Filter(Evaluate("transpose(if(a1:a100000=" & r.Address & ",b1:b100000))"), False, 0)

Thanks very much in advance

Actually I worked it out, just add the sheet name in front.

x = Filter(Evaluate("transpose(if(Sheet1!a1:a100000=" & r.Address & ",Sheet1!b1:b100000))"), False, 0)
 
Back
Top