Macro That Tests

[jjnotme]

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

 

[Gary''s Student]

Sub jjnotme()
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To n
With Cells(i, 1)
v = .Value
If Application.WorksheetFunction.IsText(v) Then
.Font.Bold = True
.Copy .Offset(0, 1)
End If
End With
Next
End Sub

 

[Mike H]

Right click the sheet tab, view code and paste this in

Sub sonic()
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A1:A" & lastrow)
For Each c In myrange
If Application.WorksheetFunction.IsText(c.Value) Then
c.Font.Bold = True
c.Offset(0, 1).Value = c.Value
End If
Next
End Sub

Mike

 

[Don Guillett]

Sub lookfortext()
mc = "a"
For i = 2 To Cells(Rows.Count, mc).End(xlUp).Row
With Cells(i, mc)
If Not IsNumeric(.Value) Then
'MsgBox i
..Font.Bold = True
..Offset(, 1) = .Value
End If
End With
Next i
End Sub

 

[Rick Rothstein \(MVP - VB\)]

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

 

[Rick Rothstein \(MVP - VB\)]

I forgot to mention... if you want the text that you copied into Column B to
be Bold, then add this line...

R.Offset(0, 1).Cells.Font.Bold = True

immediately before the last End If statement in the code I posted in my
previous message.

Rick

 

[jjnotme]

Sub jjnotme()
n = Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To n
With Cells(i, 1)
v = .Value
If Application.WorksheetFunction.IsText(v) Then
.Font.Bold = True
.Copy .Offset(0, 1)
End If
End With
Next
End Sub

Thanks so much for your help. I will try it.
Carol.

 

[jjnotme]

Right click the sheet tab, view code and paste this in

Sub sonic()
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A1:A" & lastrow)
For Each c In myrange
If Application.WorksheetFunction.IsText(c.Value) Then
c.Font.Bold = True
c.Offset(0, 1).Value = c.Value
End If
Next
End Sub

Mike

Mike:
Thanks so much for your help. I will try it.

Carol.