Help with additional formatting

[DaveH]

I seem to be having brain lock and cannot figure out how to add additional
formatting to the code.
Code below.
I'm looking for cells that contain markers and copying to a new worksheet.
I'm retaining the value of the cells and also would like to format the cells
with the ">" marker as bold and LeftJustified.
Your suggestions would be greatly appreciated.

Dave

Sheets("Items").Activate
ktr = 8
Set percrange = Range(Cells(1, 1), Cells(150, 1))
For Each thing In percrange
If IsNumeric(thing) And (thing > 0) Or (thing = ">") Or (thing =
">>") Then
ktr = ktr + 1
currrow = thing.Row
Range(Cells(currrow, 1), Cells(currrow, 9)).Select
Range(Cells(currrow, 1), Cells(currrow, 9)).Copy
Sheets("Order").Activate
Range(Cells(ktr, 1), Cells(ktr, 9)).PasteSpecial (xlPasteValues)
Sheets("Items").Activate
End If
Next

 

[Bob Phillips]

Untested

Sheets("Items").Activate
ktr = 8
Set percrange = Range(Cells(1, 1), Cells(150, 1))
For Each thing In percrange

If (IsNumeric(thing) And thing > 0) Or _
thing = ">" Or thing = ">>" Then

ktr = ktr + 1
currrow = thing.Row
Range(Cells(currrow, 1), Cells(currrow, 9)).Copy
With Sheets("Order").Range(Cells(ktr, 1), Cells(ktr, 9))

.PasteSpecial (xlPasteValues)
.Font.Bold = True
.HorizontalAlignmnet = xlLeft
End With
End If
Next

 

[CurlyDave]

This code will find all the cells in column A that have ">", using a
wildcard,
then copy Column A to Column I of that row to the first empty cell in
Sheet "Order"

Sub Button1_Click()
Dim s As String
Dim thing As Range, percrange As Range
Dim ws As Worksheet
s = ">"
Set ws = Worksheets("Items")
Set percrange = Range(Cells(1, 1), Cells(150, 1))
For Each thing In percrange.Cells
If thing Like "*" & s & "*" Then
thing.Range("A1:I1").Copy Destination:=Worksheets
("Order").Range("A65536").End(xlUp).Offset(1, 0)
End If
Next
End Sub

This code will bold the first letter in Column A Sheets "Order"

Sub BoldFirstChracter()
Dim rg As Range, c As Range
Dim ws As Worksheet
Set ws = Worksheets("Order")
Set rg = ws.Range("A2", ws.Range("A65536").End(xlUp))
For Each c In rg.Cells
With c.Characters(Start:=1, Length:=1).Font
.FontStyle = "Bold"
End With
With c.Characters(Start:=2, Length:=20).Font 'assuming there
are no more than 20 charachter in the cell
.FontStyle = "Regular"
End With
Next
End Sub