FindNext within a For Each loop - excel

Question

I need to know how to get FindNext working in my code. It finds the photo inserts it into the column where the code matches, however it does not find the next code in the worksheet, so it keeps overwriting the photos in the first find. Where I have put the comment find next photo1 is where it should be going?
Private Sub cmdInsertPhoto1_Click()
'insert the photo1 from the folder into each worksheet
Dim ws As Worksheet
Dim fso As FileSystemObject
Dim folder As folder
Dim rng As Range, cell As Range
Dim strFile As String
Dim imgFile As String
Dim localFilename As String
Dim pic As Picture
Dim findit As String
Dim finditfirst As String
Application.ScreenUpdating = True
'delete the two sheets if they still exist
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "PDFPrint" Then
Application.DisplayAlerts = False
Sheets("PDFPrint").Delete
Application.DisplayAlerts = True
End If
Next
For Each ws In ActiveWorkbook.Worksheets
If ws.Name = "DataSheet" Then
Application.DisplayAlerts = False
Sheets("DataSheet").Delete
Application.DisplayAlerts = True
End If
Next
Set fso = New FileSystemObject
Set folder = fso.GetFolder(ActiveWorkbook.Path & "\Photos1\")
'Loop through all worksheets
For Each ws In ThisWorkbook.Worksheets
ws.Select
Set rng = Range("A:A")
For Each cell In rng
If cell = "CG Code" Then
'find the next adjacent cell value of CG Code
strFile = cell.Offset(0, 1).Value 'the cg code value
imgFile = strFile & ".png" 'the png imgFile name
localFilename = folder & "\" & imgFile 'the full location
'find Photo1 cell and select the adjacent cell to insert the image
findit = Range("A:A").Find(what:="Photo1", MatchCase:=True).Offset(0, 1).Select
ActiveCell.EntireRow.RowHeight = 200 'max row height is 409.5
Set pic = ws.Pictures.Insert(localFilename)
With pic
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Width = 200
.ShapeRange.Height = ActiveCell.MergeArea.Height
.ShapeRange.Top = ActiveCell.MergeArea.Top
.ShapeRange.Left = ActiveCell.MergeArea.Left
.Placement = xlMoveAndSize
End With
'find next photo1
End If
'delete photo after insert
'Kill localFilename
Next cell
Next ws
Application.ScreenUpdating = True
' let user know its been completed
MsgBox ("Worksheets created")
End Sub

Answer 1

Scan column A for both "Photo1" and "CG Code" values to build collections for each. Then iterate the collections to insert the images.
Option Explicit
Private Sub cmdInsertPhoto1_Click()
Dim wb As Workbook, ws As Worksheet, fso As FileSystemObject
Dim rng As Range, cell As Range, pic As Picture
Dim folder As String, imgFile As String
Dim lastrow As Long, i As Long, n As Long
Dim colImages As Collection, colPhotos As Collection
Set colImages = New Collection
Set colPhotos = New Collection
Set fso = New FileSystemObject
Set wb = ActiveWorkbook
folder = wb.Path & "\Photos1\"
Application.ScreenUpdating = False
For Each ws In wb.Sheets
'delete the two sheets if they still exist
If ws.Name = "PDFPrint" Or ws.Name = "DataSheet" Then
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Else
' find images and photos
lastrow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
For Each cell In ws.Range("A1:A" & lastrow)
If cell = "CG Code" Then
imgFile = folder & cell.Offset(0, 1) & ".png"
' check exists
If fso.FileExists(imgFile) Then
colImages.Add imgFile
Else
MsgBox imgFile & " not found", vbCritical
Exit Sub
End If
ElseIf cell = "Photo1" Then
colPhotos.Add "'" & ws.Name & "'!" & cell.Offset(0, 1).Address
End If
Next
End If
Next
' copy images to sheets
For i = 1 To colImages.Count
imgFile = colImages(i)
If i <= colPhotos.Count Then
Set cell = Range(colPhotos(i))
cell.RowHeight = 200 'max row height is 409.5
Set pic = cell.Parent.Pictures.Insert(imgFile) ' ws
With pic.ShapeRange
.LockAspectRatio = msoFalse
.Width = 200
.Height = cell.MergeArea.Height
.Top = cell.MergeArea.Top
.Left = cell.MergeArea.Left
pic.Placement = xlMoveAndSize
End With
n = n + 1
Else
MsgBox "No location for " & imgFile, vbCritical, i
Exit Sub
End If
Next
Application.ScreenUpdating = True
' let user know its been completed
MsgBox n & " images inserted ", vbInformation
End Sub