How to Search Through Columns and Display Multiple Instances of Specific Value in a Row

[gregwadz]

So I have Sheet 1 which contains Client Name (Column A), Date 1 (Column B), Date 2 (Column C).

I then have Sheet 2 which contains individual dates in each cell under row A (A1 - 1/1/2017, A2 - 1/2/2017, A3 - 1/3/2017, etc).

I need a formula that searches through columns B and C on Sheet 1 and displays all Client Names that meet the specific date in the specified row. So if the client has the date 1/1/17, I want their name to display under row 1. I want ALL the clients that meet that specific date to display in the row.

I have included some sample tables to help explain what I'm trying to accomplish.

Sheet 1

Client	Date 1	Date 2
Bob Smith	1/1/2017	1/3/2017
Bill Jones	1/2/2017	1/3/2017
Jane Johnson	1/1/2017	1/4/2017
Jack Daniels	1/1/2017	1/2/2017

<tbody>
</tbody>

Sheet 2

Date	Client 1	Client 2	Client 3	Client 4
1/1/2017	Bob Smith	Jane Johnson	Jack Daniels
1/2/2017	Bill Jones	Jack Daniels
1/3/2017	Bob Smith	Bill Jones
1/4/2017	Jane Johnson

<tbody>
</tbody>

The order of the clients does not matter, but I would like columns B-K available for up to 10 clients to be inserted under one date. I tried to use a LOOKUP function but I would not be able to display multiple clients. I have a somewhat limited knowledge of Excel. Any help is appreciated. Thank you!

 

[MickG]

Not a formula , but try this for results on sheet2:-

To Save and Run Code:-
Copy code from below
In Your Data sheet , Click "Alt+F11",:- Vb Window appears.
From the VBWindow toolbar, Click "Insert" ,"Module":- New VBwindow appears .
Paste Code into this window.
Close Vbwindow.
On Data sheet Click "Developer tab", Click "Macro". Macro dialog box appears.
Select Macro (with same name) from List.
On the right of Dialog box Click "Run"
Sheet2 should now be updated.

[COLOR=navy]Sub[/COLOR] MG22Dec37
Private [COLOR=navy]Sub[/COLOR] CommandButton2_Click()
[COLOR=navy]Dim[/COLOR] Rng [COLOR=navy]As[/COLOR] Range, Dn [COLOR=navy]As[/COLOR] Range, n [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]Dim[/COLOR] K [COLOR=navy]As[/COLOR] Variant, c [COLOR=navy]As[/COLOR] [COLOR=navy]Long,[/COLOR] Sp [COLOR=navy]As[/COLOR] Variant, oMax [COLOR=navy]As[/COLOR] [COLOR=navy]Long[/COLOR]
[COLOR=navy]With[/COLOR] Sheets("Sheet1")
    [COLOR=navy]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp)).Resize(, 2)
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] CreateObject("scripting.dictionary")
.CompareMode = vbTextCompare
[COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] Dn [COLOR=navy]In[/COLOR] Rng
    [COLOR=navy]If[/COLOR] Not .Exists(Dn.Value) [COLOR=navy]Then[/COLOR]
        .Add Dn.Value, Cells(Dn.Row - 1, 1)
    [COLOR=navy]Else[/COLOR]
        .Item(Dn.Value) = .Item(Dn.Value) & "," & Cells(Dn.Row - 1, 1)
[COLOR=navy]End[/COLOR] If
[COLOR=navy]Next[/COLOR]
c = 1
 [COLOR=navy]For[/COLOR] [COLOR=navy]Each[/COLOR] K [COLOR=navy]In[/COLOR] .keys
        Sp = Split(.Item(K), ",")
        c = c + 1
        [COLOR=navy]With[/COLOR] Sheets("Sheet2")
            .Cells(c, 1) = K
            .Cells(c, 2).Resize(, UBound(Sp) + 1) = Sp
            oMax = Application.Max(oMax, UBound(Sp) + 2)
        [COLOR=navy]End[/COLOR] With
[COLOR=navy]Next[/COLOR] K
[COLOR=navy]End[/COLOR] With
[COLOR=navy]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax)
    .Parent.Cells(1, 1) = "Date"
    [COLOR=navy]For[/COLOR] n = 2 To oMax
        .Parent.Cells(1, n) = "Client " & n - 1
    [COLOR=navy]Next[/COLOR] n
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR=navy]End[/COLOR] [COLOR=navy]With[/COLOR]
[COLOR=navy]End[/COLOR] [COLOR=navy]Sub[/COLOR]

Regards Mick

 

[gregwadz]

Thanks for the reply, Mick.

I ran the macro and got the message:

"Compiled Error:

Expected End Sub"

And the error is highlighting the very first line of the code.

The first line of code now reads:

Sub MG22Dec37 ()

 

[gregwadz]

I would try to help or fix it myself, but I have no clue on the VB coding.

 

[dchaney]

There was an extra line of code at the top which was causing your issue, try this (I did not change the code, just removed the error causing text)

same code just removed the "Private Sub CommandButton2_Click()"

Sub MG22Dec37()

Dim Rng As Range, Dn As Range, n As Long
Dim K As Variant, c As Long, Sp As Variant, oMax As Long


With Sheets("Sheet1")
    Set Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp)).Resize(, 2)
End With


With CreateObject("scripting.dictionary")
    .CompareMode = vbTextCompare
    For Each Dn In Rng
        If Not .Exists(Dn.Value) Then
            .Add Dn.Value, Cells(Dn.Row - 1, 1)
        Else
            .Item(Dn.Value) = .Item(Dn.Value) & "," & Cells(Dn.Row - 1, 1)
        End If
    Next


    c = 1
    For Each K In .keys
            Sp = Split(.Item(K), ",")
            c = c + 1
            With Sheets("Sheet2")
                .Cells(c, 1) = K
                .Cells(c, 2).Resize(, UBound(Sp) + 1) = Sp
                oMax = Application.Max(oMax, UBound(Sp) + 2)
            End With
    Next K


End With


With Sheets("Sheet2").Range("A1").Resize(c, oMax)
    .Parent.Cells(1, 1) = "Date"
    
    For n = 2 To oMax
        .Parent.Cells(1, n) = "Client " & n - 1
    Next n
    .Borders.Weight = 2
    .Columns.AutoFit
End With


End Sub

 

[gregwadz]

Ah yes! The macro ran! Although it only worked somewhat correctly. Instead of outputting the name in Sheet 2, it instead output data from column A on sheet 2. To use my example above:

Sheet 1

Client	Date 1	Date 2
Bob Smith	1/1/2017	1/3/2017
Bill Jones	1/2/2017	1/3/2017
Jane Johnson	1/1/2017	1/4/2017
Jack Daniels	1/1/2017	1/2/2017

<tbody>
</tbody>

Here it what it output:

Sheet 2

Date	Client 1	Client 2	Client 3	Client 4
1/1/2017	Date	1/2/2017	1/3/2017
1/2/2017	1/1/2017	1/3/2017
1/3/2017	Date	1/1/2017
1/4/2017	1/2/2017

<tbody>
</tbody>

It appears like the code is outputting the corresponding row from Sheet 2 as opposed to Sheet 1 because under 1/1/2017, you have Date (A1), 1/2/2017 (A3), and 1/3/2017 (A4) which would correspond to the correct people in Sheet 1 (albeit they are actually under cells A2, A4, and A5, I can always just delete the header row).

I'm messing with the code a bit myself but haven't fixed it yet!

 

[dchaney]

If no one else helps you with this today, I will try to look at it tomorrow, I am about to leave for the day and can not look at it tonight.

 

[MickG]

Sorry for the problem, There was an Error relating to the active sheet. If you ran it from Sheet1 it should work, but I have now amended the code to work from either sheet.
Try this:-

[COLOR="Navy"]Sub[/COLOR] MG23Dec25
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]Dim[/COLOR] K [COLOR="Navy"]As[/COLOR] Variant, c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Sp [COLOR="Navy"]As[/COLOR] Variant, oMax [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp)).Resize(, 2)
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
    [COLOR="Navy"]If[/COLOR] Not Dic.Exists(Dn.Value) [COLOR="Navy"]Then[/COLOR]
        Dic.Add Dn.Value, .Cells(Dn.Row - 1, 1)
    [COLOR="Navy"]Else[/COLOR]
        Dic(Dn.Value) = Dic(Dn.Value) & "," & .Cells(Dn.Row - 1, 1)
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]End[/COLOR] With
c = 1
 [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] K [COLOR="Navy"]In[/COLOR] Dic.keys
        Sp = Split(Dic(K), ",")
        c = c + 1
        [COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
            .Cells(c, 1) = K
            .Cells(c, 2).Resize(, UBound(Sp) + 1) = Sp
            oMax = Application.Max(oMax, UBound(Sp) + 2)
        [COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] K
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2").Range("A1").Resize(c, oMax)
    .Parent.Cells(1, 1) = "Date"
    [COLOR="Navy"]For[/COLOR] n = 2 To oMax
        .Parent.Cells(1, n) = "Client " & n - 1
    [COLOR="Navy"]Next[/COLOR] n
    .Borders.Weight = 2
    .Columns.AutoFit
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick

 

[gregwadz]

Thank you for the reply, Mick. I'm happy to say the macro works... except it doesn't work exactly as I was intending. So I really simplified my original problem statement because I wanted it to be simple and easy to understand (I was assuming a formula would work... silly me!). So this macro would work perfectly if every single date was used (1/1/17, 1/2, 1/3, 1/4, etc), but for my actual spreadsheet, there will be missing dates. I am looking for something that would match the date from Columns B and C in Sheet 1, and match those dates with the calendar I've created in Sheet 2, and then outputting the client names who match those dates into Columns B - K on Sheet 2 under the corresponding date. So basically I'm trying to make a calendar that will show me all of the clients appointments in chronological order and to include the dates that don't have any appointments.

I'm attaching a photo that shows you what your macro is doing (this is a sample spreadsheet as to not give away confidential information) and I think you will understand what I'm looking for. Thank you so much for taking the time to help me through this. Having this calendar will be a great tool for my friend who is running her business from home.

https://postimg.org/image/qb1ntclrb/

As you can see, I was hoping the macro would auto fill the calendar without messing up the order of the dates.

 

[MickG]

Although the dates and named don't appear to add up on your Picture , I think I understand your meaning.
Try this for insertion of names against appropriate dates on sheet2.

[COLOR="Navy"]Sub[/COLOR] MG24Dec16
[COLOR="Navy"]Dim[/COLOR] Rng2 [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long[/COLOR]
[COLOR="Navy"]Dim[/COLOR] Rng1 [COLOR="Navy"]As[/COLOR] Range, Dic [COLOR="Navy"]As[/COLOR] Object, Q [COLOR="Navy"]As[/COLOR] Variant
[COLOR="Navy"]With[/COLOR] Sheets("Sheet2")
    [COLOR="Navy"]Set[/COLOR] Rng2 = .Range(.Range("A2"), .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng2: Dic.Add (Dn.Value), Array(Dn, 0): [COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Sheet1")
    [COLOR="Navy"]Set[/COLOR] Rng1 = .Range(.Range("B2"), .Range("B" & Rows.Count).End(xlUp)).Resize(, 2)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng1
    [COLOR="Navy"]If[/COLOR] Dic.exists(CDate(Dn.Value)) [COLOR="Navy"]Then[/COLOR]
        Q = Dic(CDate(Dn.Value))
            Q(1) = Q(1) + 1
            Q(0).Offset(, Q(1)).Value = .Cells(Dn.Row, 1)
            Rng2(1, Q(1) + 1).Offset(-1).Value = "Client " & Q(1)
        Dic(CDate(Dn.Value)) = Q
   [COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Dn
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]With[/COLOR]
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

Regards Mick