VBA: Add item to sheet if not currently in it

[fadetograham]

Hi everyone

I have a workbook with approx. 20 sheets, 10 with the same list of people and then a master list which each of those 10 sheets is looking up for further info.

I've written some code but am missing the final piece of the jigsaw, I want to loop through each sheet where there is the person list, check the list in that sheet and make sure it has all of the people listed in the master list.

The code I've written works but if the master list is sorted differently to the individual sheets then it adds them.

Code is below and any help is greatly appreciated.

Sub Add_New_Driver()
Dim ws As Worksheet
Dim wsml As Worksheet
Dim lr As Long
Dim mllr As Long
Dim a As Long
Dim b As Long
Set wsml = ThisWorkbook.Worksheets("Master List")
wsml.Activate
mllr = Cells(Rows.Count, 1).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
    
    If (ws.Name = "AR PDP ADR") Or (ws.Name = "Smiths System") Or (ws.Name = "HGV Licence Expiry") Or (ws.Name = "TBTs") Or (ws.Name = "D&A Test") _
    Or (ws.Name = "UWSO Pre Start") Or (ws.Name = "UWSO Load") Or (ws.Name = "UWSO Discharge") Or (ws.Name = "UWSO Drive") Or (ws.Name = "Bi Annual Medical") Then
    
    ws.Activate
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    
        For a = 2 To mllr
            b = 2
            For b = 2 To lr
                If wsml.Cells(a, 1) = ws.Cells(b, 1) Then
                Exit For
                ElseIf wsml.Cells(a, 1) <> ws.Cells(b, 1) Then
                lr = lr + 1
                ws.Cells(lr, 1) = wsml.Cells(a, 1)
                End If
            Next
        Next
    End If
Next
    
End Sub

 

[wideboydixon]

I'd probably be inclined to change this to use something more efficient than a brute force search (e.g. Application.Match) but in the spirit of your original code, I think this might do what you're after:

Sub Add_New_Driver()
Dim ws As Worksheet
Dim wsml As Worksheet
Dim lr As Long
Dim mllr As Long
Dim a As Long
Dim b As Long
Dim f As Boolean
Set wsml = ThisWorkbook.Worksheets("Master List")
wsml.Activate
mllr = Cells(Rows.Count, 1).End(xlUp).Row
For Each ws In ThisWorkbook.Worksheets
    
    If (ws.Name = "AR PDP ADR") Or (ws.Name = "Smiths System") Or (ws.Name = "HGV Licence Expiry") Or (ws.Name = "TBTs") Or (ws.Name = "D&A Test") _
    Or (ws.Name = "UWSO Pre Start") Or (ws.Name = "UWSO Load") Or (ws.Name = "UWSO Discharge") Or (ws.Name = "UWSO Drive") Or (ws.Name = "Bi Annual Medical") Then
    
    ws.Activate
    lr = Cells(Rows.Count, 1).End(xlUp).Row
    
        For a = 2 To mllr
            f = False
            For b = 2 To lr
                If wsml.Cells(a, 1) = ws.Cells(b, 1) Then
                    f = True
                    Exit For
                End If
            Next
            If Not f Then
                lr = lr + 1
                ws.Cells(lr, 1) = wsml.Cells(a, 1)
            End If
        Next
    End If
Next
    
End Sub

WBD

 

[Scott T]

You could use countif to see if the name is on the sheet.

    lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
    For x = 2 To lr
        a = Application.CountIf(Sheets("Sheet1").Range("A2:A" & lr1), ws.Cells(x, 1))
        If a = 0 Then
            Sheets("Sheet1").Cells(lr1 + 1, 1) = ws.Cells(x, 1)
            lr1 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
        End If
    Next x

 

[Fluff]

How about

Sub Add_New_Driver()

   Dim Sht As Variant
   Dim WsMl As Worksheet
   Dim ShtAry As Variant
   Dim Nms As Variant
   Dim Nm As Variant
   Dim Tst As Variant
   
   ShtAry = Array("AR PDP ADR", "Smiths System", "HGV Licence Expiry", "TBTs", "D&A Test", "UWSO Pre Start", "UWSO Load", "UWSO Discharge", "UWSO Drive", "Bi Annual Medical")
   Set WsMl = ThisWorkbook.Worksheets("Master List")
   Nms = WsMl.Range("A2", WsMl.Range("A" & Rows.Count).End(xlUp)).Value
   
   For Each Sht In ShtAry
      With Sheets(Sht)
         For Each Nm In Nms
            Tst = Application.Match(Nm, .Range("A2", .Range("A" & Rows.Count).End(xlUp)), 0)
            If IsError(Tst) Then .Range("A" & Rows.Count).End(xlUp).Offset(1).Value = Nm
         Next Nm
      End With
   Next
   
End Sub

EDITED
As pointed out by WBD I forgot to change one of the sheet names. That's been corrected.

 

[wideboydixon]

   Set WsMl = ThisWorkbook.Worksheets("Postcodes")

Postcodes?

WBD

 

[Fluff]

Postcodes?

WBD

Thanks for pointing out my deliberate mistake
I've now corrected it

 

[fadetograham]

Hi guys

Thank you so much for all your replies.

I went with WBD's version as it is was the smallest change against what I'd already written but it's good to know there are a few different ways of doing it. Will definitely look into application.match, not come across that before.

That's again

Graham

 

[Scott T]

Match is an excel function, that is why you use application.match instead of just match in VBA. It returns the row number of where the match if found.

 

[wideboydixon]

Although Application.Match is not documented whereas WorksheetFunctions.Match is documented. The former, however, is more graceful when no match is found, allowing you to use IsError() around the result.

WBD