'How can I implement a loop into my code and handle errors more efficiently

I'm creating a report and have automated the procedure for grabbing images and dropping them in. It is working, but is longer than it needs to be. I'm hoping someone can help me lighten the code by implementing a loop.

I tried several ways, but when it comes to the area to drop the image in, it seems to always default to the initial variable I set.

Sub AutoFillInImages() 
    'DS# = image file name 
    'DS#_1 = folder name beneath F:\Merchandising\Style's Numbers\DS#\DS# PIC\
    'DS#_2 = sub folder beneath DS#.2 or official DS# folder
     
    Dim Pic As Object 
    Dim shp As Shape
    Dim rng As Range
    Set rng = Range("A14")
     
    DS1 = rng & " A.jpg"
    DS1_1 = Left(DS1, 6) & "00-" & Mid(DS1, 4, 3) & "99"
    DS1_2 = Left(DS1, 8)
     
    On Error GoTo DS2
    Set shp = ActiveSheet.Shapes.AddPicture(Filename:="F:\Merchandising\Style's Numbers\DS#\DS# PIC\" _
        & DS1_1 & "\" & DS1_2 & "\" _
        & DS1, LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, Left:=340, Top:=46, Width:=-1, Height:=-1)
    With shp
        .Top = rng.Offset(-9, 0).Top
        .Left = rng.Offset(-2, 0).Left
        .LockAspectRatio = msoTrue
        .Height = 190
        .IncrementTop 5
        .IncrementLeft 40
    End With
     
    DS2:
    Set rng = Range("A27")
     
    DS1 = rng & " A.jpg"
    DS1_1 = Left(DS1, 6) & "00-" & Mid(DS1, 4, 3) & "99"
    DS1_2 = Left(DS1, 8)

    On Error GoTo DS3
    Set shp = ActiveSheet.Shapes.AddPicture(Filename:="F:\Merchandising\Style's Numbers\DS#\DS# PIC\" _
        & DS1_1 & "\" & DS1_2 & "\" _
        & DS1, LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, Left:=340, Top:=46, Width:=-1, Height:=-1)
    With shp
        .Top = rng.Offset(-9, 0).Top
        .Left = rng.Offset(-2, 0).Left
        .LockAspectRatio = msoTrue
        .Height = 190
        .IncrementTop 5
        .IncrementLeft 40
    End With
     
    DS3:
    Set rng = Range("A40")
     
    DS1 = rng & " A.jpg"
    DS1_1 = Left(DS1, 6) & "00-" & Mid(DS1, 4, 3) & "99"
    DS1_2 = Left(DS1, 8)
     
     
    Set shp = ActiveSheet.Shapes.AddPicture(Filename:="F:\Merchandising\Style's Numbers\DS#\DS# PIC\" _
        & DS1_1 & "\" & DS1_2 & "\" _
        & DS1, LinkToFile:=msoFalse, _
        SaveWithDocument:=msoCTrue, Left:=340, Top:=46, Width:=-1, Height:=-1)
    With shp
        .Top = rng.Offset(-9, 0).Top
        .Left = rng.Offset(-2, 0).Left
        .LockAspectRatio = msoTrue
        .Height = 190
        .IncrementTop 5
        .IncrementLeft 40
    End With
 
 
End Sub

This code above works, it's just longer than I know it needs to be.



Solution 1:[1]

Create a sub or function which you can call repetitively with a different parameter (Rng). Avoid the use of GoTo. Use On Error Resume Next instead and then create a bracket with If Err.Number = 0 Then for the next section of code to avoid running it in case of error. Note that a renewed On Error Resume Next resets the Err object.

Sources

This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.

Source: Stack Overflow

Solution Source
Solution 1 Variatus