Loop stopping at row 10

Jasen79

New Member
Joined
Nov 25, 2020
Messages
47
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
Below is a code I had a lot of help with from user such as yourself.
This code worked well but now is stopping a row 10 and I can't see why!
Could one of you please be so kind to point out why this is happening and how I might fix it?
What should be happen in short is and does up to row 10, is the code will like at a cell, see if there is a xxx.jpg name, if there is then it looks it up in a folder from on the PC, and insert the picture, then loops on to the next row and cell.
Thank you for your help and insight.

Code:
Sub Pic_insert()

    Dim last_row As Long
    Dim cell As Range
    Dim col_num As Long
    Dim j As Long, i As Long

    last_row = Sheets(1).Range("I654").End(xlUp).Row
    
        Do While Sheets(1).Cells(last_row, 9) = 0
        last_row = last_row - 1
    Loop
    
    For j = 2 To last_row Step 1
    For i = 9 To 11 Step 1
                        
            InsertirPictures Cells(j, i)

        Next i
    Next j

End Sub
Sub InsertirPictures(cel As Range)
    ' Help from YKY & RoryA
    ' Personal Note: Below file path needs to be changed to where the IR photos are located!!!
    '
    Const fPath = "C:\Users\576186\Pictures\"

    Dim picPath As String

    picPath = fPath & cel.Value
    If Not Dir(picPath, vbDirectory) = vbNullString Then
        cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
        Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125

    End If

End Sub
 
If you want to refer to the active sheet, regardless of where it is, use Activesheet instead of Sheets(1) - or you could use Sheets("sheet name"). The Sheets(number) syntax is numbered from left to right in the tab order of your workbook.
Rory or Joe, is there a line of code to skip cells if it has no data?
I have looked up some other threads but can't seem to isolate the verbiage.
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
You could use:

Code:
If Len(Cells(j, i).Value) <> 0 then InsertirPictures Cells(j, i)
 
Upvote 0
Most Updated Version. Hope this can help someone else. Thank you everyone!!!

VBA Code:
Sub Insertpics()

    Dim last_row As Long
    Dim cell As Range
    Dim col_num As Long
    Dim j As Long, i As Long

    last_row = ActiveSheet.Range("J150").End(xlUp).Row
    MsgBox "Initial last_row value = " & last_row
        Do While ActiveSheet.Cells(last_row, 10) = 0
        last_row = last_row - 1
    Loop
    MsgBox "Revised last_row value = " & last_row
    
    For j = 3 To last_row Step 1
    For i = 10 To 14 Step 1
                        
    If Len(Cells(j, i).Value) <> 0 Then InsertirPictures Cells(j, i)

        Next i
    Next j
            'Displays a message at the end
         MsgBox "Macro Complete!"
End Sub
Sub InsertirPictures(cel As Range)
    ' Help from YKY & RoryA
    ' Personal Note: Below file path needs to be changed to where the IR phots are located!!!
    '
    Const fPath = "C:\Users\576186\Pictures\Small\"

    Dim picPath As String

    picPath = fPath & cel.Value
    If Not Dir(picPath, vbDirectory) = vbNullString Then
        cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
        Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125

    End If

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,214,943
Messages
6,122,369
Members
449,080
Latest member
Armadillos

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top