Macro to Loop Through List of Names and Find Worksheet with Same Name

[andybason]

Hello

I have a worksheet that has a list of people's names in column B of a worksheet called Summary. It starts at B9 and can vary in length. Most names in this list correspond have a worksheet of the same name but some don't.

I would like to be able to loop through each name in the list, find if there is a worksheet with the same name and, if there is, copy and paste the value in A1 of that worksheet into the cell next to the name in column C.

Is this possible?

Thank you

 

[mikerickson]

With Sheets("Summary").Range("B:B")
    With Range(.Cells(9, 1), .Cells(Rows.Count, 1).End(xlUp)).Offset(0, 1)
        .FormulaR1C1 = "=IFERROR(INDIRECT(""'"" & RC[-1]&""'!A1""),"""")"
        .Value = .Value
    End With
End With

 

[Yongle]

also returns list of missing sheets

Sub LoopNames()
    Dim cel As Range, msg As String
    For Each cel In Sheets("Summary").Range("B9", Sheets("Summary").Range("B" & Rows.Count).End(xlUp))
        On Error Resume Next
        cel.Offset(, 1) = Sheets(cel.Text).Range("A1")
        If Err.Number <> 0 Then msg = msg & vbCr & cel
        On Error GoTo 0
    Next cel
    If msg <> "" Then MsgBox msg, , "Not found"
End Sub

code supplied by @mikerickson does not contain a loop and therefore is much faster

 

[sykes]

Another way - bit less slick than the other Folk, but I'd already made the effort!!

Sub check_name()
Dim sht As Worksheet
Dim lst_rw As Integer
Dim fnd_rw As Integer
Dim rng As Range
Dim fnd As Range

With Sheets("Summary")

    lst_rw = .Range("B500").End(xlUp).Row
     Set rng = .Range("B9:B" & lst_rw)
    
    For Each sht In Me.Sheets
        Set fnd = rng.Find(sht.Name, LookIn:=xlValues)
        If Not fnd Is Nothing Then .Range("C" & fnd.Row).Value = sht.Range("A1").Value
    
    Next

End With

End Sub

 

[andybason]

Thanks guys