Excel incorrectly placing images - excel

Question

I'm trying to help out a coworker with her VBA in Excel 2013. It looks like the macro is successfully pulling in the images from the designated path, but it dumps every single photo into cell A1.
Any thoughts?
Sub DeleteAllPictures()
Dim S As Shape
For Each S In ActiveSheet.Shapes
Select Case S.Type
Case msoLinkedPicture, msoPicture
S.Delete
End Select
Next
End Sub
Sub UpdatePictures()
Dim R As Range
Dim S As Shape
Dim Path As String, FName As String
'Setup the path
Path = "G:\In Transit\Carlos\BC Website images"
'You can read this value also from a cell, e.g.:
'Path = Worksheets("Setup").Range("B1")
'Be sure the path has a trailing backslash
If Right(Path, 1) <> "\" Then Path = Path & "\"
'Visit each used cell in column A
For Each R In Range("B1", Range("B" & Rows.Count).End(xlUp))
'Try to get the shape
Set S = GetShapeByName(R)
'Found?
If S Is Nothing Then
'Find the picture e.g. "C:\temp\F500.*"
FName = Dir(Path & R & ".*")
'Found?
If FName <> "" Then
Set S = InsertPicturePrim(Path & FName, R)
End If
End If
If Not S Is Nothing Then
'Show the error if the name did not match the cell
If S.Name <> R Then R.Interior.Color = vbRed
With R.Offset(0, 1)
'Move the picture to the cell on the right side
S.Top = .Top
S.Left = .Left
'Resize it
S.Width = .Width
'Remove the aspect ratio by default if necessary
'S.LockAspectRatio = False
If S.LockAspectRatio Then
'Make it smaller to fit the cell if necessary
If S.Height > .Height Then S.Height = .Height
Else
'Stretch the picture
S.Height = .Height
End If
End With
'Move it behind anything else
S.ZOrder msoSendToBack
Else
R.Offset(0, 1) = "No picture available"
End If
Next
End Sub
Private Function GetShapeByName(ByVal SName As String) As Shape
'Return the shape with SName, Nothing if not exists
On Error Resume Next
Set GetShapeByName = ActiveSheet.Shapes(SName)
End Function
Private Function InsertPicturePrim(ByVal FName As String, ByVal SName As String) As Shape
'Inserts the picture, return the shape, Nothing if failed
Dim P As Picture
On Error Resume Next
'Insert the picture
Set P = ActiveSheet.Pictures.Insert(FName)
'code to resize
With P
.ShapeRange.LockAspectRatio = msoFalse
.Height = ActiveCell.Height
.Width = ActiveCell.Width
.Top = ActiveCell.Top
.Left = ActiveCell.Left
.Placement = xlMoveAndSize
End With
Set P = Nothing
'code to resize
'Success?
If Not P Is Nothing Then
'Return the shape
Set InsertPicturePrim = P.ShapeRange(1)
'Rename it, so we can easily find it later
P.Name = SName
End If
End Function

Answer 1

The short answer is: your macro is inserting the picture at the selected cell. Change the selection before the insert line, and you should get it inserted at each row.
Here in this example, I am selecting the cell to the left of the cell you are pulling the name value from.
If FName <> "" Then
'select the cell 1 to the left of the cell containing the image name
R.Offset(0,-1).select
Set S = InsertPicturePrim(Path & FName, R)
End If