PICK OUT/EXTRACT column header "COMMON" IN ALL 5 SHEETS

[panyagak]

Hi Excel gurus

Please help.

My 4 worksheets are named: Wk1, Wk2, Wk3 &
Wk4, Wk5. In the 5 sheets, columns A (Date) and B ( Subject name) are similar. I need a vba code to
pick out only"Subject names" that ARE COMMON in ALL THE 5 sheets and paste them in a new sheet, "New All".

Am tired of copy, paste & sort more than 20,000 rows!!

HELP!!

 

[gallen]

Can the names repeat in the same sheet?

If not it's just a simple case of looping through each name in Wk1 and if it is found in all other sheets place it in New All

If it does then need to check that the name has been searched before.

 

[panyagak]

A good question Gallen.

Yes the names might repeat 2, 3, 4 times but with differebt values in one or more sheets..

Picking just one is ok or as you deem fit

regards
Patrick

 

[gallen]

This will do it if names don't repeat or doesn't matter if they do

Sub FindAll()

    Dim rNames As Range, Name As Range, rFound As Range
    Dim lr As Long 'Last row in Wk1
    Dim nr As Long ' next available row in New All
    Dim i As Integer 'counter for worksheets
    
    
    lr = Worksheets("Wk1").Range("A" & Rows.Count).End(xlUp).Row
    nr = Worksheets("New All").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    'Get Names range
    Set rNames = Worksheets("Wk1").Range("B2:B" & lr)
    
    For Each Name In rNames
        For i = 2 To 5 'loop though worksheets 2 to 5
            'find an exact match
            Set rFound = Worksheets("Wk" & i).Range("B:B").Find(What:=Name, LookAt:=xlWhole)
            If rFound Is Nothing Then 'name not found so don't enter on New All
                GoTo NextName
            End If
        Next i
        'only get here if name is found in each sheet
        Name.EntireRow.Copy
        Worksheets("New All").Range("A" & nr).PasteSpecial xlPasteAll
        nr = nr + 1
        Application.CutCopyMode = False
NextName:
    Next Name
    
End Sub

 

[panyagak]

Gallen.

Yes names do repeat themselves in 2 to 3 sheets each with different values. each sheet is filled with 5 different colours - hope they"re maintained in the final sheet.

Patrick

 

[gallen]

Ok so if they repeat and you don't want to search for them again:

Sub FindAll()
    Dim rNames As Range, Name As Range, rFound As Range
    Dim lr As Long 'Last row in Wk1
    Dim nr As Long ' next available row in New All
    Dim i As Integer 'counter for worksheets
    Dim sNamesSearched As String 'String to hold values of all names searched for
    
    
    lr = Worksheets("Wk1").Range("A" & Rows.Count).End(xlUp).Row
    nr = Worksheets("New All").Range("A" & Rows.Count).End(xlUp).Row + 1
    
    'Get Names range
    Set rNames = Worksheets("Wk1").Range("B2:B" & lr)
    
    For Each Name In rNames
        If InStr(1, sNamesSearched, Name) > 0 Then GoTo NextName 'if name already searched skip the name
        sNamesSearched = IIf(sNamesSearched = "", Name, sNamesSearched & "," & Name) 'record the name searched for
        For i = 2 To 5 'loop though worksheets 2 to 5
            'find an exact match
            Set rFound = Worksheets("Wk" & i).Range("B:B").Find(What:=Name, LookAt:=xlWhole)
            
            If rFound Is Nothing Then 'name not found so don't enter on New All
                GoTo NextName
            End If
        Next i
        'only get here if name is found in each sheet
        Name.EntireRow.Copy
        Worksheets("New All").Range("A" & nr).PasteSpecial xlPasteAll
        nr = nr + 1
        Application.CutCopyMode = False
NextName:
    Next Name
    
End Sub

 

[panyagak]

Gallen.

will try both out in the course of the day & get back in case of any hitch.

thank you & God bless for quick resolution.

 

[panyagak]

Gallen & thanks for your robust reply.

Have gone through your code & spotted these in quotes
"If"
"sNamesSearched = IIf(sNamesSearched = "", Name, sNamesSearched & "," & Name) 'record the name
searched for
For i = 2 To 5 'loop though worksheets 2 to 5"
"through"

Should the code remain the way it is, OR its 2 errors - "If" & "through" - to correct.

regards
Patrick

 

[gallen]

Gallen & thanks for your robust reply.

Have gone through your code & spotted these in quotes
"If"
"sNamesSearched = IIf(sNamesSearched = "", Name, sNamesSearched & "," & Name) 'record the name
searched for
For i = 2 To 5 'loop though worksheets 2 to 5"
"through"

Should the code remain the way it is, OR its 2 errors - "If" & "through" - to correct.

regards
Patrick

Yes 'though' should read 'through', simple typo in a comment.

No the IIF is correct it does the "If Then End If" all in one line. if you google IIF Vba you will get a clear explanation

 

[panyagak]

Thanks Gallen