Compare multiple column using dictionary VBA
Results 1 to 7 of 7

Thread: Compare multiple column using dictionary VBA

  1. #1
    New Member
    Join Date
    Sep 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Compare multiple column using dictionary VBA

    Hi everybody,

    I am hoping someone might be able to help with this problem

    I have 5 columns in sheet1
    column A have all the names of employee that attendant today
    Column B have the names of all employees of department 1
    Column C have the names of all employees of department 2
    and so on till column E with names of department 4

    So I need to create 4 columns in sheet2 for the 4 departments every one contain the names of employees that attendant today from each department.

    I already created vlookup formula to achieve that, however it takes so long to process
    I believe creating a scripting dictionary for the 5 column and compare them against the first column would be much faster

    any help would be mostly appreciated.

  2. #2
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,480
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Compare multiple column using dictionary VBA

    Welcome to the Board.

    Open a copy of your workbook. Press Alt-F11 to open the VBA editor. Press Alt-IM to open a new module. Paste the following code into the window that opens:

    Code:
    Sub Attendees()
    Dim s1 As Range, s2 As Range, i As Long, j As Long, mycol(1 To 5) As Variant
    Dim ix(1 To 4) As Long, mydict(1 To 5) As Object, x As Variant, y As Variant
    
    
        Set s1 = Sheets("Sheet1").Range("A1")
        Set s2 = Sheets("Sheet2").Range("A1")
        
        For i = 1 To 5
            mycol(i) = s1.Range(s1.Cells(1, i), s1.Cells(Rows.Count, i).End(xlUp)).Value
            Set mydict(i) = CreateObject("Scripting.Dictionary")
            For j = 2 To UBound(mycol(i))
                mydict(i)(mycol(i)(j, 1)) = 1
            Next j
        Next i
        
        s2.Resize(Rows.Count, 4).ClearContents
        s2.Resize(1, 4).Value = s1.Offset(0, 1).Resize(1, 4).Value
        
        ReDim Output(1 To UBound(mycol(1)), 1 To 4)
        For Each x In mydict(1)
            For j = 2 To 5
                If mydict(j).Exists(x) Then
                    ix(j - 1) = ix(j - 1) + 1
                    Output(ix(j - 1), j - 1) = x
                    Exit For
                End If
            Next j
        Next x
        
        s2.Offset(1).Resize(UBound(Output), 4).Value = Output
            
    End Sub
    Change the values in red to match your sheets. s1 should point to the upper left corner on sheet1, and s2 should be the upper left corner on sheet2. This assumes there is a header row on both sheets.

    Press Alt-Q to close the editor. In Excel, press Alt-F8. Choose Attendees and click Run.

    Let us know if this works for you.
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  3. #3
    New Member
    Join Date
    Sep 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Compare multiple column using dictionary VBA

    Wow, Thank you very much Eric W.
    It works like a charm.

  4. #4
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,480
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Compare multiple column using dictionary VBA

    Happy to help.

  5. #5
    New Member
    Join Date
    Sep 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Compare multiple column using dictionary VBA

    one last question
    Is it possible to add a 5th column with names that do not exist in the 4 departments?
    Thank you in advance

  6. #6
    MrExcel MVP Eric W's Avatar
    Join Date
    Aug 2015
    Location
    Bountiful, UT
    Posts
    8,480
    Post Thanks / Like
    Mentioned
    42 Post(s)
    Tagged
    5 Thread(s)

    Default Re: Compare multiple column using dictionary VBA

    Try this:

    Code:
    Sub Attendees()
    Dim s1 As Range, s2 As Range, i As Long, j As Long, mycol(1 To 5) As Variant
    Dim ix(1 To 5) As Long, mydict(1 To 5) As Object, x As Variant, y As Variant
    Dim output() As String
    
        Set s1 = Sheets("Sheet1").Range("A1")
        Set s2 = Sheets("Sheet2").Range("A1")
        
        For i = 1 To 5
            mycol(i) = s1.Range(s1.Cells(1, i), s1.Cells(Rows.Count, i).End(xlUp)).Value
            Set mydict(i) = CreateObject("Scripting.Dictionary")
            For j = 2 To UBound(mycol(i))
                mydict(i)(mycol(i)(j, 1)) = 1
            Next j
        Next i
        
        s2.Resize(Rows.Count, 4).ClearContents
        s2.Resize(1, 4).Value = s1.Offset(0, 1).Resize(1, 4).Value
        s2.Offset(, 4).Value = "Other"
        
        ReDim output(1 To UBound(mycol(1)), 1 To 5)
        For Each x In mydict(1)
            For j = 2 To 5
                If mydict(j).Exists(x) Then Exit For
            Next j
            ix(j - 1) = ix(j - 1) + 1
            output(ix(j - 1), j - 1) = x
        Next x
        
        s2.Offset(1).Resize(UBound(output), 5).Value = output
            
    End Sub
    Cheers,
    Eric

    When you eliminate the impossible, whatever remains, however improbable, must be the truth.

    -Posting guidelines, forum rules, terms of use, FAQs, BB codes, See how to search the forum
    -Post a screen shot with the HTML Maker

  7. #7
    New Member
    Join Date
    Sep 2019
    Posts
    4
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Compare multiple column using dictionary VBA

    Thanks again Eric.
    I really appreciate all of your help

Some videos you may like

User Tag List

Tags for this Thread

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •