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

Question

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. Thank you for your time looking at this!

Variatus Variatus · Accepted Answer · 2019-01-14T02:59:33

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.

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

1 Answers