Importing Pictures From Directory Unaligning The Further It Loops

Hi all,

I have a piece of code that imports pictures from my directory in columns of 10 by X rows. For every row imported it seems to shift down by a pixel, overtime this starts to notice if I was to run it for a 1000 row, it would be shifted further down than what it should be.

Now I can't for the life of me understand why as I'm not sure how to skip loop iterations through F8 to understand what it's doing. Here's the following full code:

Sub Box()

    Dim oNewPic As Shape
    Dim shpShape As Shape
    Dim rngPicPosition As Range
    Dim rngRange As Range
    Dim x As Long
    Dim iStartColumn As Long
    Dim iStartRow As Long
    Dim i As Long
    Dim j As Long
    
'   Speed up processing
    sbar ("Please wait ... importing pictures")
    Call TurnOff
    
'   Delete existing data, including pictures (Shapes)
    For Each shpShape In template.Shapes
        shpShape.Delete
    Next
    With template
        mylr = .Range("A1").SpecialCells(xlCellTypeLastCell).Row
        mylc = .Range("A1").SpecialCells(xlCellTypeLastCell).Column
        If mylr > 4 Then
            Set rngRange = .Range(.Cells(2, 2), .Cells(mylr, mylc))
            rngRange.ClearContents
            Call NoBorders(rngRange)
            rngRange.EntireRow.Delete
        End If
    End With
    
'   Insert Pictures
    i = 1
    j = 0
    With data
    
        mylr = LR(, .Name, "A")
        
        For x = 4 To mylr
        
            sbar ("Please wait ... importing picture " & i & " of " & mylr - 3)
            iStartColumn = MyColLong(CStr(.Cells(x, 16).Value))
            
            If iStartRow <> .Cells(x, 18) Then
                iStartRow = .Cells(x, 18)
                Worksheets(template.Name).Cells(iStartRow, 1).RowHeight = 118.75
            End If
            
            Set rngPicPosition = Worksheets(template.Name).Cells(iStartRow, iStartColumn)
            
            If FileExists(sFolder & .Cells(x, 10) & ".jpg") = False Then
            
                j = j + 1


            If FileExists(lFolder & .Cells(x, 10) & ".png") = False Then
            
                Dim PNF As Worksheet, LR1 As Long
                Set PNF = ThisWorkbook.Sheets("Pictures Not Found DIR")
                LR1 = PNF.Cells(PNF.Rows.Count, "A").End(xlUp).Row + 1
                
                If Application.WorksheetFunction.CountIf(PNF.Range("A2:A" & LR1), .Cells(x, 10)) > 0 Then
                
                Else
                
                 PNF.Range("A" & LR1) = .Cells(x, 10)
                 
                End If


            Else
                j = j - 1
                                Set oNewPic = Sheets(template.Name).Shapes.AddPicture(Filename:=lFolder & .Cells(x, 10) & ".png", _
                                                                      linktofile:=msoFalse, _
                                                                      savewithdocument:=msoCTrue, _
                                                                      Left:=rngPicPosition.Left, _
                                                                      Top:=rngPicPosition.Top, _
                                                                      Width:=-1, Height:=-1)
                With oNewPic
                    .Height = 100.629933
                    .Width = 92.6929242
                    .IncrementLeft 26.1
                    .IncrementTop 8.7
                    .LockAspectRatio = msoTrue
                    .Rotation = 0
                End With
                


                
            End If




                rngPicPosition.Offset(1, 0) = .Cells(x, 10)
                rngPicPosition.Offset(2, 0) = .Cells(x, 11)
                rngPicPosition.Offset(1, 1) = .Cells(x, 14)
                rngPicPosition.Offset(0, -1) = .Cells(x, 5)
                rngPicPosition.Offset(3, 0) = .Cells(x, 13)
                rngPicPosition.Offset(3, 0).NumberFormat = "0"
                rngPicPosition.Offset(3, 1) = .Cells(x, 12)
                rngPicPosition.Offset(3, 1).NumberFormat = "$#,##0.00"
                If .Cells(x, 14) <> "" Then rngPicPosition.Offset(2, 1) = .Cells(x, 24)
                rngPicPosition.Offset(2, 1).NumberFormat = "0.0"


                


                
                Set rngRange = rngPicPosition.Resize(5, 2)
                Call MyLineStyle(rngRange)
            Else
                Set oNewPic = Sheets(template.Name).Shapes.AddPicture(Filename:=sFolder & .Cells(x, 10) & ".jpg", _
                                                                      linktofile:=msoFalse, _
                                                                      savewithdocument:=msoCTrue, _
                                                                      Left:=rngPicPosition.Left, _
                                                                      Top:=rngPicPosition.Top, _
                                                                      Width:=-1, Height:=-1)
                With oNewPic
                    .Height = 100.629933
                    .Width = 92.6929242
                    .IncrementLeft 26.1
                    .IncrementTop 8.7
                    .LockAspectRatio = msoTrue
                    .Rotation = 0
                End With
                
                rngPicPosition.Offset(1, 0) = .Cells(x, 10)
                rngPicPosition.Offset(2, 0) = .Cells(x, 11)
                rngPicPosition.Offset(3, 0) = .Cells(x, 13)
                rngPicPosition.Offset(3, 0).NumberFormat = "0"
                rngPicPosition.Offset(1, 1) = .Cells(x, 14)
                rngPicPosition.Offset(0, -1) = .Cells(x, 5)
                rngPicPosition.Offset(3, 1) = .Cells(x, 12)
                rngPicPosition.Offset(3, 1).NumberFormat = "$#,##0.00"
                If .Cells(x, 14) <> "" Then rngPicPosition.Offset(2, 1) = .Cells(x, 24)
                rngPicPosition.Offset(2, 1).NumberFormat = "0.0"
                
                Set rngRange = rngPicPosition.Resize(5, 2)
                Call MyLineStyle(rngRange)
            End If
            i = i + 1
        Next x
    End With


    Set oNewPic = Nothing
    Set rngPicPosition = Nothing
    Set shpShape = Nothing
    Set rngRange = Nothing
    
    Call TurnOn
    
    Call MergeCells
    
    Call PrintArea
    
    Call WidthHeight
    
    mymsg = MsgBox(mylr - 3 & " Pictures have been processed, " & j & " of those were not found in the library.", vbOKOnly + vbInformation, "Information")


End Sub

I think it's something to do with this line of code but unsure why it would come out of sync?

Any help would be greatly appreciated!

                                Set oNewPic = Sheets(template.Name).Shapes.AddPicture(Filename:=lFolder & .Cells(x, 10) & ".png", _
                                                                      linktofile:=msoFalse, _
                                                                      savewithdocument:=msoCTrue, _
                                                                      Left:=rngPicPosition.Left, _
                                                                      Top:=rngPicPosition.Top, _
                                                                      Width:=-1, Height:=-1)

OR if anyone knows how to test if all shapes in a worksheet = incrementleft 26.1 incrementtop 8.7, if not then re-adjust?

What I do at the moment is F5 Objects, Cut and Copy it back into first cell, however this pastes as one picture now instead of multiple so I have to drag across and down?