Excel VBA - How to perform an action only on it first occurance in a loop?

[knifey]

Hi,
I have some code that adds images to the rows of an Excel spreadsheet and it works great. But, I now have an input file that has 35000 rows that use the same 2 images on hundreds of rows (35000 rows!).
Obviously I can't display all 35000 images on a single worksheet so I'm looking for a solution. The easiest way would be to not add the same 2 images to every row but just add them on the first applicable row. Then skip the other rows until the image filenames have changed.
I know what is needed, I'm just finding this one a bit difficult to get down into code
Any help or advice would be much appreciated.
Thanks,
K

My existing code:

Sub addPictures1()
Dim myPict As Picture
Dim myRng As Range
Dim myCell As Range
Dim myPictName As Variant
Dim wb1 As Workbook
Dim rowHeightVal As Long
Dim wb1EndRowResultsToUpload As Long
Dim selectedImageFolder As String
Dim colAJstr As String
Dim strtRow As Long
Application.ScreenUpdating = False
Set wb1 = ThisWorkbook
selectedImageFolder = wb1.Worksheets("Admin").Range("G13").Value
If selectedImageFolder <> "" Then
    wb1EndRowResultsToUpload = wb1.Worksheets("ResultsToUpload").Range("A65536").End(xlUp).Row
    wb1.Worksheets("ResultsToUpload").Rows("2:" & wb1EndRowResultsToUpload).Columns("AM:AN").ClearContents
    rowHeightVal = wb1.Worksheets("Control").Range("L11").Value
    wb1.Worksheets("ResultsToUpload").Pictures.Delete
    If wb1.Worksheets("ResultsToUpload").Range("A2").Value <> "" Then
        With wb1.Worksheets("ResultsToUpload")
            Set myRng = .Range("AH2", .Cells(.Rows.Count, "AH").End(xlUp)).SpecialCells(xlCellTypeVisible)
            myRng.RowHeight = rowHeightVal
        End With
        For Each myCell In myRng.Cells
            Call API_DoEvents
            DoEvents
            Application.StatusBar = "Processing row " & myCell.Row
            If Trim(myCell.Value) = "" Then
                'do nothing
            ElseIf Dir(CStr(myCell.Value)) = "" Then
                'picture not there!
                With myCell.Offset(0, 5)
                    .Value = "Image Not Found"
                End With
            Else
                With myCell.Offset(0, 5)
                    Set myPict = myCell.Parent.Pictures.Insert(myCell.Value)
                    myPict.Top = .Top
                    myPict.Width = .Width
                    myPict.Height = .Height
                    myPict.Left = .Left
                    myPict.Placement = xlMoveAndSize
                End With
            End If
            colAJstr = myCell.Offset(0, 2).Value
            If Trim(colAJstr) = "" Then
                'do nothing
            ElseIf Dir(CStr(colAJstr)) = "" Then
                'picture not there!
'                With myCell.Offset(0, 6)
'                    .Value = "Image Not Found"
'                End With
            Else
                With myCell.Offset(0, 6)
                    Set myPict = myCell.Parent.Pictures.Insert(colAJstr)
                    myPict.Top = .Top
                    myPict.Width = .Width
                    myPict.Height = .Height
                    myPict.Left = .Left
                    myPict.Placement = xlMoveAndSize
                End With
            End If
        Next myCell
    End If
Else
    MsgBox ("No image folder selected.")
    GoTo endBit
End If
MsgBox ("Done")
endBit:
Application.StatusBar = ""
Set wb1 = Nothing
Set myRng = Nothing
Set myCell = Nothing
Set myPict = Nothing
End Sub

 

[SkipVought]

Hi,

Put a counter within your loop and use the value of the counter to make decisions

Dim I as integer

For each obj in collection
  If I = 0 then
     'Do something first time
  End if
  'Do something each time

  I = I + 1
Next

Skip,

_{Just traded in my old subtlety...
for a NUANCE!}

 

[DaveInIowa]

Before entering the loop, declare and set a variable that will hold the previous value of the cell you want to check for a change. Make sure you set the initial value to something you know will cause a "level break" the first time through the loop ...

Dim previousMyCellValue As String
previousMyCellValue = ""

For Each myCell In myRng.Cells

    If (myCell.Value <> previousMyCellValue) Then
        [green]' This is the first row for myCell.Value[/green]
        
        [green]' Add the image here ...[/green]
        
        previousMyCellValue = myCell.Value
    End If

    [green]' Normal row processing goes here ...[/green]
    
Next