Loop & Find problems

Welcome to Exceltip forum

Please take a couple of minutes and read the forum rules then edit your thread title by following the instructions in the rules (Rule 1) and wrap your VBA code (Rule 3)

An Announcement thread that covers the rules is at the top of each forum or you may use the link below in my signature.

Try this

Option Explicit

Sub LoopPeds()
    '
    ' LoopPeds Macro
    ' Macro recorded 5/10/2008 by Mohom
    '
    ' Keyboard Shortcut: Ctrl+w
    Dim rng    As Range
    Dim rng2   As Range
    Dim cl     As Range
    Const str  As String = "Paediatric"


    Set rng = Range(Cells(1, 3), Cells(Rows.Count, 3).End(xlUp))
    For Each cl In rng
        If cl.Value = str Then
            If rng2 Is Nothing Then
                Set rng2 = cl
            Else: Set rng2 = Union(cl, rng2)
            End If
        End If
    Next cl
    If Not rng2 Is Nothing Then

        rng2.Offset(0, 2).Value = "Peds"
        With rng2.Font
            .Name = "Arial"
            .FontStyle = "Bold"
            .Size = 10
            .Strikethrough = False
            .Superscript = False
            .Subscript = False
            .OutlineFont = False
            .Shadow = False
            .Underline = xlUnderlineStyleNone
            .ColorIndex = xlAutomatic
        End With
    Else: MsgBox "No instances of " & str & " were found"
    End If
    '

End Sub