Have a range, Myrange. want to find each cell that has font size 18 in it.

I've been trying by using the find method. Can't get it right. I did the
record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell it
is found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

this may do what you want:

Sub test()
Dim MyRange As Range
Dim fstr As String
Dim cell As Range
Set MyRange = Range("A1:I1")

For Each cell In MyRange
If cell.Font.Size = 18 Then
If fstr = "" Then
fstr = cell.Address
Else
fstr = fstr & ", " & cell.Address
End If
End If
Next
If fstr "" Then MsgBox fstr
End Sub


--


Gary


"John" wrote in message
...
Have a range, Myrange. want to find each cell that has font size 18 in it.

I've been trying by using the find method. Can't get it right. I did the
record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell it is
found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

I'm trying to avoid for/next loops in favor of the find function because
it is supposed to be a lot faster.
John

Gary Keramidas wrote:
this may do what you want:

Sub test()
Dim MyRange As Range
Dim fstr As String
Dim cell As Range
Set MyRange = Range("A1:I1")

For Each cell In MyRange
If cell.Font.Size = 18 Then
If fstr = "" Then
fstr = cell.Address
Else
fstr = fstr & ", " & cell.Address
End If
End If
Next
If fstr "" Then MsgBox fstr
End Sub

Something to get you started

Sub TryMe()
Range("A1:I1").Select
For Each mycell In Selection
If mycell.Font.Size = 18 Then
MsgBox mycell.Value & " " & mycell.Address
End If
Next
End Sub

best wishes
--
Bernard V Liengme
Microsoft Excel MVP
http://people.stfx.ca/bliengme
remove caps from email

"John" wrote in message
...
Have a range, Myrange. want to find each cell that has font size 18 in it.

I've been trying by using the find method. Can't get it right. I did the
record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell it is
found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

This should do what you want
-Andrew

Sub IdentifyFontSize18()

Dim Rng As Range
On Error Resume Next
Application.DisplayAlerts = False

'Have the user select a range to loop through
Set Rng = Application.InputBox(Prompt:="Please select a range
to run macro on.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True

'If the selection is blank, exit routine
If Rng Is Nothing Then
Exit Sub
Else

'Get the first row
Dim intrownum As Integer
intrownum = Rng.Row

'loop through each row
For Each c In Rng
If c.Font.Size = 18 Then
MsgBox "Cell " & Chr(c.Column + 64) & c.Row & " has
size 18 font"
End If
Next c

End If

End Sub

I'm trying to use the find method instead of for/next loops because it's
supposed to be faster and is certainly a lot cleaner to use and see in
the program.

Thus:

Myrange = the range I want to look in

Set FoundIt = MyRange.Find(What:="" SearchOrder:=xlByColumns and so on
so it finds any cell with font.size = 18

And I'm done In two simple lines of code. If I want to look for more I
just use Findnext.

It looks like I should be able to do this but it doesn't work.

John



AndrewArmstrong wrote:
This should do what you want
-Andrew

Sub IdentifyFontSize18()

Dim Rng As Range
On Error Resume Next
Application.DisplayAlerts = False

'Have the user select a range to loop through
Set Rng = Application.InputBox(Prompt:="Please select a range
to run macro on.", _
Title:="SPECIFY RANGE", Type:=8)
On Error GoTo 0
Application.DisplayAlerts = True

'If the selection is blank, exit routine
If Rng Is Nothing Then
Exit Sub
Else

'Get the first row
Dim intrownum As Integer
intrownum = Rng.Row

'loop through each row
For Each c In Rng
If c.Font.Size = 18 Then
MsgBox "Cell " & Chr(c.Column + 64) & c.Row & " has
size 18 font"
End If
Next c

End If

End Sub

I understand these for/next methods. I'm trying to avoid for/next loops
in favor of the find function.
John

Bernard Liengme wrote:
Something to get you started

Sub TryMe()
Range("A1:I1").Select
For Each mycell In Selection
If mycell.Font.Size = 18 Then
MsgBox mycell.Value & " " & mycell.Address
End If
Next
End Sub

best wishes

not sure if you can do what you want, but this should find the first instance.

then here's a kb about it.
http://support.microsoft.com/kb/282151

Sub test()
Dim MyRange As Range
Dim rngfound As Range
Set MyRange = Range("A1:P1")
Application.FindFormat.Font.Size = 18
With MyRange
Set rngfound = .Find(after:=Range("A1"), What:="", _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=True)
End With
MsgBox rngfound.Address
End Sub
--


Gary


"John" wrote in message
...
Have a range, Myrange. want to find each cell that has font size 18 in it.

I've been trying by using the find method. Can't get it right. I did the
record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell it is
found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

So then something like this should find all the required cells I would
guess...

Sub Test()
Dim R As Range
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A1:A100")
Set Found = Cells(Rng.Count, Rng.Column)
Application.FindFormat.Font.Size = 18
For Each R In Rng
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

--
Rick (MVP - Excel)


"Gary Keramidas" <GKeramidasATmsn.com wrote in message
...
not sure if you can do what you want, but this should find the first
instance.

then here's a kb about it.
http://support.microsoft.com/kb/282151

Sub test()
Dim MyRange As Range
Dim rngfound As Range
Set MyRange = Range("A1:P1")
Application.FindFormat.Font.Size = 18
With MyRange
Set rngfound = .Find(after:=Range("A1"), What:="", _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
_
SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=True)
End With
MsgBox rngfound.Address
End Sub
--


Gary


"John" wrote in message
...
Have a range, Myrange. want to find each cell that has font size 18 in
it.

I've been trying by using the find method. Can't get it right. I did the
record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell it
is found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

Here is same code, but modified slightly to eliminate the overhead
associated with iterating a range of cells... I changed the loop from a For
Each to an "normal" For..Next loop. I also changed the method of calculating
the initial cell reference assigned to the Found variable (since the first
method I used would not always calculate the last cell in the the range
assigned to Rng correctly)

Sub Test()
Dim X As Long
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A24")
' Start with the last cell in the range so that
' the addresses will list in ascending order.
Set Found = Range(Split(Rng.Address & ":" & Rng.Address, ":")(1))
Application.FindFormat.Font.Size = 18
For X = 1 To Rng.Count
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
So then something like this should find all the required cells I would
guess...

Sub Test()
Dim R As Range
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A1:A100")
Set Found = Cells(Rng.Count, Rng.Column)
Application.FindFormat.Font.Size = 18
For Each R In Rng
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

--
Rick (MVP - Excel)


"Gary Keramidas" <GKeramidasATmsn.com wrote in message
...
not sure if you can do what you want, but this should find the first
instance.

then here's a kb about it.
http://support.microsoft.com/kb/282151

Sub test()
Dim MyRange As Range
Dim rngfound As Range
Set MyRange = Range("A1:P1")
Application.FindFormat.Font.Size = 18
With MyRange
Set rngfound = .Find(after:=Range("A1"), What:="", _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows,
_
SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=True)
End With
MsgBox rngfound.Address
End Sub
--


Gary


"John" wrote in message
...
Have a range, Myrange. want to find each cell that has font size 18 in
it.

I've been trying by using the find method. Can't get it right. I did the
record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell it
is found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

rick:

just wondering. is this going to be any faster than the for each cell loop i and
others originally posted?

--


Gary


"Rick Rothstein" wrote in message
...
Here is same code, but modified slightly to eliminate the overhead associated
with iterating a range of cells... I changed the loop from a For Each to an
"normal" For..Next loop. I also changed the method of calculating the initial
cell reference assigned to the Found variable (since the first method I used
would not always calculate the last cell in the the range assigned to Rng
correctly)

Sub Test()
Dim X As Long
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A24")
' Start with the last cell in the range so that
' the addresses will list in ascending order.
Set Found = Range(Split(Rng.Address & ":" & Rng.Address, ":")(1))
Application.FindFormat.Font.Size = 18
For X = 1 To Rng.Count
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
So then something like this should find all the required cells I would
guess...

Sub Test()
Dim R As Range
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A1:A100")
Set Found = Cells(Rng.Count, Rng.Column)
Application.FindFormat.Font.Size = 18
For Each R In Rng
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

--
Rick (MVP - Excel)


"Gary Keramidas" <GKeramidasATmsn.com wrote in message
...
not sure if you can do what you want, but this should find the first
instance.

then here's a kb about it.
http://support.microsoft.com/kb/282151

Sub test()
Dim MyRange As Range
Dim rngfound As Range
Set MyRange = Range("A1:P1")
Application.FindFormat.Font.Size = 18
With MyRange
Set rngfound = .Find(after:=Range("A1"), What:="", _
LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=True)
End With
MsgBox rngfound.Address
End Sub
--


Gary


"John" wrote in message
...
Have a range, Myrange. want to find each cell that has font size 18 in it.

I've been trying by using the find method. Can't get it right. I did the
record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell it is
found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

While the output we all produced is the same, the method to get there is
different. My code creates a range via the Union function whereas the
others' code simply concatenates the addresses into a string for display.
The difference is that the range I produce from the union can be manipulated
directly in the routine as needed (select all the cells, change the cells'
format in some way, etc.). Now, it is true, you can do the same to the
Range(rngfound.Address) range, but I don't know if that would be considered
as "clean" a method to use or not. As for your speed question... I'm not
entirely sure how fast creating Unions are, but I don't think the mechanism
is all that slow; string concatenations, on the other hand, is not one of
VB's speediest processes (especially if the strings get large in value).

--
Rick (MVP - Excel)


"Gary Keramidas" <GKeramidasATmsn.com wrote in message
...
rick:

just wondering. is this going to be any faster than the for each cell loop
i and others originally posted?

--


Gary


"Rick Rothstein" wrote in message
...
Here is same code, but modified slightly to eliminate the overhead
associated with iterating a range of cells... I changed the loop from a
For Each to an "normal" For..Next loop. I also changed the method of
calculating the initial cell reference assigned to the Found variable
(since the first method I used would not always calculate the last cell
in the the range assigned to Rng correctly)

Sub Test()
Dim X As Long
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A24")
' Start with the last cell in the range so that
' the addresses will list in ascending order.
Set Found = Range(Split(Rng.Address & ":" & Rng.Address, ":")(1))
Application.FindFormat.Font.Size = 18
For X = 1 To Rng.Count
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

--
Rick (MVP - Excel)


"Rick Rothstein" wrote in message
...
So then something like this should find all the required cells I would
guess...

Sub Test()
Dim R As Range
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A1:A100")
Set Found = Cells(Rng.Count, Rng.Column)
Application.FindFormat.Font.Size = 18
For Each R In Rng
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

--
Rick (MVP - Excel)


"Gary Keramidas" <GKeramidasATmsn.com wrote in message
...
not sure if you can do what you want, but this should find the first
instance.

then here's a kb about it.
http://support.microsoft.com/kb/282151

Sub test()
Dim MyRange As Range
Dim rngfound As Range
Set MyRange = Range("A1:P1")
Application.FindFormat.Font.Size = 18
With MyRange
Set rngfound = .Find(after:=Range("A1"), What:="", _
LookIn:=xlFormulas, LookAt:=xlPart,
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False,
SearchFormat:=True)
End With
MsgBox rngfound.Address
End Sub
--


Gary


"John" wrote in message
...
Have a range, Myrange. want to find each cell that has font size 18 in
it.

I've been trying by using the find method. Can't get it right. I did
the record macro thing and got:

----------
Range("A1:I1").Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Selection.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas,_
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext,_
MatchCase:=False, SearchFormat:=True).Activate
-------------


That's find on the worksheet but in VB it doesn't give me which cell
it is found in so I try:

--------
Dim Found as range, MyRange as Range
Set MyRange = Range(Cells(1,1),Cells(1,18)

MyRange.Select
With Application.FindFormat.Font
.Size = 18
.Subscript = False
End With
Set Found = Myrange.Find(What:="", After =... etc. etc.
--------------


That produces an error. Help

John

Good thought. Be fun to set up some sort of test. I don't even know
where I heard that find method is faster than loops.
John

Gary Keramidas wrote:
rick:

just wondering. is this going to be any faster than the for each cell loop i and
others originally posted?

That works for me. thanks
For some reason you can't use Findnext so I use the Find(After=) and
stop when it = First.

I've never seen that splitting of the range address.
Thanks again


John



Rick Rothstein wrote:
Here is same code, but modified slightly to eliminate the overhead
associated with iterating a range of cells... I changed the loop from a
For Each to an "normal" For..Next loop. I also changed the method of
calculating the initial cell reference assigned to the Found variable
(since the first method I used would not always calculate the last cell
in the the range assigned to Rng correctly)

Sub Test()
Dim X As Long
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A24")
' Start with the last cell in the range so that
' the addresses will list in ascending order.
Set Found = Range(Split(Rng.Address & ":" & Rng.Address, ":")(1))
Application.FindFormat.Font.Size = 18
For X = 1 To Rng.Count
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub

I've never seen that splitting of the range address.

It's my own invention.<g The idea is to get the last address in the range,
but to protect against that range being a single cell (where there is no
colon in the address to Split on).

--
Rick (MVP - Excel)


"John" wrote in message
...
That works for me. thanks
For some reason you can't use Findnext so I use the Find(After=) and stop
when it = First.

I've never seen that splitting of the range address.
Thanks again


John



Rick Rothstein wrote:
Here is same code, but modified slightly to eliminate the overhead
associated with iterating a range of cells... I changed the loop from a
For Each to an "normal" For..Next loop. I also changed the method of
calculating the initial cell reference assigned to the Found variable
(since the first method I used would not always calculate the last cell
in the the range assigned to Rng correctly)

Sub Test()
Dim X As Long
Dim Rng As Range
Dim Found As Range
Dim AllSize18Cells As Range
Dim FirstRange As String
Set Rng = Range("A24")
' Start with the last cell in the range so that
' the addresses will list in ascending order.
Set Found = Range(Split(Rng.Address & ":" & Rng.Address, ":")(1))
Application.FindFormat.Font.Size = 18
For X = 1 To Rng.Count
Set Found = Rng.Find(After:=Found, What:="", MatchCase:=False, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, LookAt:=xlPart, _
SearchFormat:=True)
If Found.Address = FirstRange Then Exit For
If AllSize18Cells Is Nothing Then
Set AllSize18Cells = Found
FirstRange = Found.Address
Else
Set AllSize18Cells = Union(AllSize18Cells, Found)
End If
Next
MsgBox AllSize18Cells.Address
End Sub