Insert Picture In Cell By Matching Employee ID

If anyone needs help with the same issue -

Sub InsertPics()
        
    On Error Resume Next
        
    Dim Cell As Range, EmpID As String
    Const Path As String = "E:\Deep Dave\Excel Sheets\Survey\Photographs\"
    
    Application.ScreenUpdating = False
    
    For Each Cell In Range("Rng")
    
        If Len(Cell.Value) = 4 Then
            Cell.Select
            EmpID = Cell.Value + 0
            ActiveSheet.Pictures.Insert(Path & EmpID & ".jpg").Select
            With Selection
                .Placement = xlMoveAndSize
                .ShapeRange.LockAspectRatio = msoFalse
                .ShapeRange.Height = ActiveCell.Height
                .ShapeRange.Width = ActiveCell.Width
                .ShapeRange.Name = Cell.Value
            End With
        End If
        
    Next Cell

    Application.ScreenUpdating = True
    
End Sub