ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Help with additional formatting (https://www.excelbanter.com/excel-programming/424198-help-additional-formatting.html)

Daveh

Help with additional formatting
 
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[_3_]

Help with additional formatting
 
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

--
__________________________________
HTH

Bob

"DaveH" wrote in message
...
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




curlydave

Help with additional formatting
 
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



All times are GMT +1. The time now is 01:18 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com