VBA code to check (1) if a name is already listed and if not AND if vale of adjacent cell >0 then add

[Mel Smith]

I have two spreadsheets in different workbooks. On my Personnel sheet I have a long (1,000+) list of names in column B. In a different workbook, ='[Averages.xlsm]Seconds, I have a list of names in cells B4:B63.
What I want to do is loop through ='[Averages.xlsm]Seconds cells B4:B63 and if there is a name that is not listed on my Personnel sheet in column B, then loop through ='[Averages.xlsm]Seconds cells C4:C63 and if >0 then add the cell contents of the adjacent cell in column B to the next empty cell in column B on the Personnel sheet.

I.E. if, say B24 of my '[Averages.xlsm]Seconds is listed in Personnel column B then do nothing. If B24 of my '[Averages.xlsm]Seconds is not listed and C24 '[Averages.xlsm]Seconds >0 then add '[Averages.xlsm]Seconds B24 to the next empty cell in column B on the Personnel sheet.

As always, your help will be much appreciated.

Mel

 

[Mel Smith]

I have managed to get my code working

Sub CopyNames()
    Dim wb1 As Workbook, wb2 As Workbook 'Declare the workbooks
    Dim ws1 As Worksheet, ws2 As Worksheet 'Declare the worksheets
    Dim rng1 As Range, rng2 As Range
    Dim cell As Range
    Dim lastrow1 As Long, lastrow2 As Long
    Dim found As Boolean
   
    Set wb1 = Workbooks("Personnel Records.xlsm")
    Set wb2 = Workbooks("Averages.xlsm")
    Set ws1 = wb1.Sheets("Personnel")
    Set ws2 = wb2.Sheets("Players")
   
    lastrow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row
    'lastrow2 = ws2.Cells(Rows.Count, "B").End(xlUp).Row
    lastrow2 = 63
   
    Set rng1 = ws1.Range("B1:B" & lastrow1)
    Set rng2 = ws2.Range("B4:B" & lastrow2)
   
    For Each cell In rng2
        found = False
        For Each Name In rng1
            If cell.Value = Name.Value Then
                found = True
                Exit For
            End If
        Next Name
        If Not found And cell.Offset(0, 1).Value > 0 Then
            lastrow1 = lastrow1 + 1 'Increment the last row by 1
            ws1.Cells(lastrow1, "B").Value = cell.Value
        End If
    Next cell
End Sub

Phew! Mel

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

 

[Mel Smith]

Sorry! Duly noted.
Mel