Find and Format Macro

I am trying to create a macro that searches my spreadsheet for anything between parentheses and changes text size by -1 (or to 12...whichever). I have tried several scripts but cannot get anything to work. All of my parentheses are in one column, but they are not the only text in the column [eg. John Smith (abc123)]. I need to reduce (abc123) down one text size to 12. This script also needs to find all instances and apply to all. I am somewhat new to macros but am finding that they make me so much more productive. Any help would be greatly appreciated.

This is what I have so far...even though it gives me an error on the With .Selection line.

Sub FindSpecial()
' Keyboard Shortcut: Ctrl+Shift+Q
With .Selection
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Text = "\(*\)"
.Replacement.Text = "^&"
.Replacement.Font.Size = 12
.Forward = True
.Wrap = wdFindContinue
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
.Execute Replace:=wdReplaceAll
End With
End With
End Sub

I can't get past the compile error at the With .Selection line to see if this actually does what I want. I'm thinking that the replacement text still needs to be "\(*\)" . Is this correct? Like I said, I am very new to this but am trying to learn.

hi dbutler85, can you post sample file with original data and data you need to obtain as a result (5-10 rows will be enough)?

I'm sorry, I can't. It contains private medical information. But I can give an example.

Date	Last, First (MRN1234)	Med Info
Date	Last, First (ABC4321)	Med Info
Date2	Last Name, First (BFR0492)	Med Info

I want to take what is in parenthesis and format the font to be one size smaller. The problem that I am having is that a macro isn't editing just part of the cell, it is applying the change to the entire cell. Is this enough info?

I think this code will do what you want...

Sub FindSpecial()
Dim oFind As Object
Dim rRange As Range
Dim sFind As String
Dim c As Integer, l As Integer

'Set the column with your data
'If your data contains more than 20,000 records then adjust the range
'Be sure to select your Sheet name as well
Set rRange = Sheet2.Range("B1:B" & Sheet2.Range("B20000").End(xlUp).Row)

With rRange
    'Find the cell containing the (
    Set oFind = .Find("(", LookAt:=xlPart)
    If oFind Is Nothing Then GoTo CleanUp:
    sFind = oFind.Address 'Prevent endless loop
    Do
        'Find the start and end of your data to resize
        c = InStr(1, oFind.Value, "(") + 1
        l = InStr(c, oFind.Value, ")") - c
        'Select those characters and resize
        oFind.Characters(c, l).Font.Size = oFind.Font.Size - 1
        Set oFind = .FindNext(oFind)
    Loop Until oFind.Address = sFind
End With

CleanUp:
Set rRange = Nothing
Set oFind = Nothing
End Sub

Thank you Chance. That works. I changed "Sheet2.Range" to "ActiveSheet.Range" in both places and it works perfectly. Thank you so much.