Find and replace code in VBA

Question

I am new to stackoverflow and VBA as well. I am trying to write a code which reads name of a File from one Sheet tab, goes to another Sheet tab, looks for this File name. If the code finds File name from Sheet1 exactly the same as in Sheet2, it highlights the color of that cell in Sheet2. I have partial success in doing so. Here are the problems:

In Sheet1, the file names are like FILE 001, FILE 028, FILE 38, FILE 102 etc. I have manually changed some of the file names to have three digits in their number (just to test the code). As long as the code reaches FILE 38, its stops. So question1, how can I first change all the file names to have 3 digits in their names?

Secondly, in Sheet2, FILE 001 appears more than once. My code only highlights the first instance it finds. How to solve this issue? I am copying the code below and appreciate help.

Sub ColorImportantFiles()

Dim NumberOfCells As Integer
Dim LoopCounter As Integer
Dim FileName As String
Dim SearchFileRange As Range

Worksheets("Sheet1").Activate
NumberOfCells = Range("A3:A38").Count

For LoopCounter = 1 To NumberOfCells
    Worksheets("Sheet1").Activate
    FileName = Range("A2").Offset(LoopCounter, 1).Value

    Worksheets("Sheet2").Activate
    Set SearchFileRange = Range("B3", Range("B2").End(xlDown))

       If SearchFileRange.Find(what:=FileName, lookat:=xlWhole) = FileName Then
       SearchFileRange.Find(what:=FileName, lookat:=xlWhole).Interior.Color 
   = rgbBlueViolet

       Else: Exit Sub
       End If
   Next LoopCounter
End Sub

Answer 1

you could try this:

Option Explicit

Sub ColorImportantFiles()

    Dim fileName As String, firstAddress As String
    Dim searchFileRange As Range, cell As Range, f As Range, cellsToColor As Range

    With Worksheets("Sheet2")
        Set searchFileRange = .Range("B3", .Range("B2").End(xlDown))
        Set cellsToColor = .Range("A1")
    End With

    For Each cell In Worksheets("Sheet1").Range("A3:A38").SpecialCells(xlCellTypeConstants)
        fileName = "FILE " & Format(Split(cell.Value, " ")(1), "000")
        With searchFileRange
            Set f = .Find(what:=fileName, LookIn:=xlValues, lookat:=xlWhole)
            If Not f Is Nothing Then
                firstAddress = f.Address
                Do
                    Set cellsToColor = Union(f, cellsToColor)
                    Set f = .FindNext(f)
                Loop While f.Address <> firstAddress
            End If
        End With
    Next
    If cellsToColor.Count > 1 Then Intersect(cellsToColor, cellsToColor.Parent.Columns(2)).Interior.Color = rgbBlueViolet

End Sub