This should be relatively fast...

Sub FindBoldAndCopy()
Dim C As Range
Dim R As Range
Dim FirstAddress As String
With ActiveSheet.Range("A:A")
Set C = .Find("*", LookIn:=xlValues)
If Not C Is Nothing Then
FirstAddress = C.Address
Do
If R Is Nothing Then
Set R = C
Else
Set R = Union(R, C)
End If
Set C = .FindNext(C)
Loop While Not C Is Nothing And C.Address < FirstAddress
R.Cells.Font.Bold = True
R.Offset(0, 1).Value = R.Value
End If
End With
End Sub

Rick


"jjnotme" wrote in message
...
I need a macro that tests whether there is text in any cell in column A.
If there is text, I need to bold that cell/cells, and also copy it to
column
B. Please let me know how to do this Thanks