Search Multiple values based in an unique row and compare to other table and return inital value if not found

[EddyVilla]

Hi,

let me explain what im trying to achieve:

-We have a list of people identified by ID, in Worksheet #1 there are no duplicate IDs however we have several trainings related to that ID (123 has Excel, PPT and Word), in Worksheet #2 its a separate report in where the ID is duplicated because there are more than 1 training completed by "123".

What i need is a way to say "What Trainings are in Worksheet #1 and in Worksheet #2 for "123", IF FOUND delete the trainings found" so the result will be "123 | (blank) | (blank) | Word "

Note: these sheets have around 16k rows.

Worksheet #1
[TABLE="class: grid, width: 500"]
<TBODY>[TR]
[TD]ID
[/TD]
[TD]Training 1
[/TD]
[TD]Training#2
[/TD]
[TD]Training #3
[/TD]
[/TR]
[TR]
[TD]123
[/TD]
[TD]Excel
[/TD]
[TD]Power Point
[/TD]
[TD]Word
[/TD]
[/TR]
[TR]
[TD]456
[/TD]
[TD]Excel
[/TD]
[TD]Word
[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]789
[/TD]
[TD]Excel
[/TD]
[TD]Visio
[/TD]
[TD][/TD]
[/TR]
</TBODY>[/TABLE]

Worksheet #2
[TABLE="class: grid, width: 500"]
<TBODY>[TR]
[TD]ID
[/TD]
[TD]Training 1
[/TD]
[/TR]
[TR]
[TD]123
[/TD]
[TD]Excel
[/TD]
[/TR]
[TR]
[TD]456
[/TD]
[TD]Excel
[/TD]
[/TR]
[TR]
[TD]789
[/TD]
[TD]Excel
[/TD]
[/TR]
[TR]
[TD]123
[/TD]
[TD]Power Point
[/TD]
[/TR]
</TBODY>[/TABLE]


Thank you very much for your help!

 

[VBA Geek]

Can you try the below?

Sheet5 is where your "non duplicates are", Sheet6 is the other.

Sub training()
Dim aCell As Range
Dim F As Worksheet: Set F = ThisWorkbook.Sheets("Sheet5")
Dim O As Worksheet: Set O = ThisWorkbook.Sheets("Sheet6")
Dim x As Long, lRow As Long
Dim myID As String
Dim Trainings As Range
lRow = O.Cells(Rows.Count, 1).End(xlUp).Row


Dim Train1 As String, train2 As String, train3 As String


For x = 2 To F.Cells(Rows.Count, 1).End(xlUp).Row
    Train1 = F.Cells(x, 2)
    train2 = F.Cells(x, 3)
    train3 = F.Cells(x, 4)
    myID = F.Cells(x, 1)
        With O
            .Activate
            .Range("A1:B1").AutoFilter 1, myID
                Set Trainings = .Range("A1").CurrentRegion.Offset(1).Resize(lRow - 1, 1).Offset(, 1).SpecialCells(xlCellTypeVisible)
                 
                    For Each aCell In Trainings.Cells
                        Select Case aCell.Value
                            Case Train1
                                F.Cells(x, 2).ClearContents
                            Case train2
                                F.Cells(x, 3).ClearContents
                            Case train3
                                F.Cells(x, 4).ClearContents
                        End Select
                    Next
              
        End With
Next
End Sub

 

[EddyVilla]

Hi VBA GEEK,

Thanks for replying to my post, there is an error of "1004 - No Cells Found" and the code (debug) stops at:

Set Trainings = .Range("A1").CurrentRegion.Offset(1).Resize(lRow - 1, 1).Offset(, 1).SpecialCells(xlCellTypeVisible)


Sheet 5 and sheet 6 were modified to Sheet1 and Sheet 2 according your comment, also upon error the sheet2 is left selected with filter applied with no values returned.

Any thoughts??

Thank you!!

 

[VBA Geek]

the error was due to the fact that some IDs in "sheet5" were not in "sheet6". I implicitly assumed that all the IDs of sheet 5 could be found in sheet6. You can run the below then

Sub training()

Application.ScreenUpdating = False
Dim aCell As Range
Dim F As Worksheet: Set F = ThisWorkbook.Sheets("Sheet5")
Dim O As Worksheet: Set O = ThisWorkbook.Sheets("Sheet6")
Dim x As Long, lRow As Long
Dim myID As String
Dim Trainings As Range
lRow = O.Cells(Rows.Count, 1).End(xlUp).Row

Dim Train1 As String, train2 As String, train3 As String

For x = 2 To F.Cells(Rows.Count, 1).End(xlUp).Row
    Train1 = UCase(F.Cells(x, 2))
    train2 = UCase(F.Cells(x, 3))
    train3 = UCase(F.Cells(x, 4))
    myID = F.Cells(x, 1)
        With O
            .Activate
            .Range("A1:B1").AutoFilter 1, myID
                On Error GoTo Skipnotfound
                Set Trainings = .Range("A1").CurrentRegion.Offset(1).Resize(lRow - 1, 1).Offset(, 1).SpecialCells(xlCellTypeVisible)
                    For Each aCell In Trainings.Cells
                        Select Case UCase(aCell.Value)
                            Case Train1
                                F.Cells(x, 2).ClearContents
                            Case train2
                                F.Cells(x, 3).ClearContents
                            Case train3
                                F.Cells(x, 4).ClearContents
                        End Select
                    Next
Skipnotfound:
        End With
Next
O.ShowAllData
Application.ScreenUpdating = True
MsgBox "Done"
End Sub

 

[EddyVilla]

Hi VBA Geek,

Great Thank you!!!!!!!!!!!!!!