Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations gkittelson on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Excel Macro Cell Formatting question 1

Status
Not open for further replies.

MyFlight

Technical User
Feb 4, 2002
193
Does anyone know if there is an easy way in Excel to write a Macro to do the following.

I have 2 Formulas in Cells L10 and M10. If the value is over Zero I wnat to change the Cell Color and formatting of another Cell and then delete the Formulas.

Basically if L10 is Greater than 0 the format Cell L8 (Red Cell, White Letters)

Range("L8").Select
Range("L10").FormulaR1C1 = "=SUM(COUNTIF(Status!C[-9],""SLMB*""),COUNTIF(Status!C[-9],""SLMD*""),COUNTIF(Status!C[-9],""SLMQ*""),COUNTIF(Status!C[-9],""WAML*""))"

Basically if L10 is Greater than 0 the format Cell L8 (Red Cell, White Letters)
Range("M8").Select
Range("M10").FormulaR1C1 = "=SUM(COUNTIF(Status!C[-10],""SLMB*""),COUNTIF(Status!C[-10],""SLMD*""),COUNTIF(Status!C[-10],""SLMQ*""),COUNTIF(Status!C[-10],""WAML*""))"

In addition I need to add a comment to K10 "Count Difference"

Any and all help will be appreciated.
 





Hi,

"Basically if L10 is Greater than 0 the format Cell L8 (Red Cell, White Letters)"

Have you tried using your macro recorder, in order to make "Cell L8 (Red Cell, White Letters)?"

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Skip,

The Macro recorder only work to change the formatting on Cell L10. I need to change the Formatting on Cell L8 if Cell L10 is greater then Zero.

I tried the following, however it chages the formatting no matter what value is in cell L10. Any Ideas?


Sub Macro3()
'
' Macro3 Macro
' Macro recorded 6/12/2008
'

'
Const SAVESTR As String = "0"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Range("L10").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Row > 1 Then
Range("L8").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range("A1").Select
End If
End Sub
 


Try this...
Code:
    Set myRange = Range("L10").Find(What:=SAVESTR, After:=Range("L10"), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False)
    If myRange Is Nothing Then
        MsgBox "Unresolved Error"
    Else
        If myRange.Row > 1 Then
            With Range("L8")
                .Font.Bold = True
                .Interior.ColorIndex = 3
            End With
        End If
    End If
Notice that NOTHING is selected and that there is no early exit from the procedure.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 




sorry, I forgot the font color...
Code:
    Set myRange = Range("L10").Find(What:=SAVESTR, After:=Range("L10"), LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
        False)
    If myRange Is Nothing Then
        MsgBox "Unresolved Error"
    Else
        If myRange.Row > 1 Then
            With Range("L8")
                With Font
                    .Font.Bold = True
                    .ColorIndex = 2
                End With
                .Interior.ColorIndex = 3
            End With
        End If
    End If


Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Skip,

here is what I came up with. Does this look right to you?


Sub MainHubDigitalFormat()
'
' MainHubDigitalFormat Macro
' Macro Created On 6/12/2008 by Ralph M. Hill
'

'
Const SAVESTR As String = "0"
Dim myRange As Range
Dim cell As Range
Dim delRange As Range

Range("L10").FormulaR1C1 = "=SUM(COUNTIF(Status!C[-9],""SLMB*""),COUNTIF(Status!C[-9],""SLMD*""),COUNTIF(Status!C[-9],""SLMQ*""),COUNTIF(Status!C[-9],""WAML*""))"
Range("L10").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Value > 0 Then
Range("L8").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Else
Range("A1").Select
End If

Range("M10").FormulaR1C1 = "=SUM(COUNTIF(Status!C[-10],""SLMB*""),COUNTIF(Status!C[-10],""SLMD*""),COUNTIF(Status!C[-10],""SLMQ*""),COUNTIF(Status!C[-10],""WAML*""))"
Range("M10").Select
On Error Resume Next
Selection.Find(What:=SAVESTR, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If Err.Number <> 91 And Err.Number <> 0 Then
MsgBox "Unresolved Error"
Exit Sub
End If
If ActiveCell.Value > 0 Then
Range("M8").Select
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 2
End With
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Range("C10:W10").Select
Selection.ClearContents
Range("C10").Select
Range("I10").FormulaR1C1 = "SLMB, SLMD, SLMQ, and or WAML boards are included in the Digital Line Count"
Range("I10").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection.Font
.Name = "Arial"
.FontStyle = "Bold"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 3
End With
Range("C2").Select
Else
Range("C10:W10").Select
Selection.ClearContents
Range("C10").Select
End If
End Sub
 




Does it WORK?

I'd advise to quit selecting. Reference ranges directly, as I demonstrated in my code segment.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Skip,

Does Slecting the Cells slow the Macro down?
 




Without a doubt. There are only a very few instances where it is necessary to use the Select Method for any object.

Skip,

[glasses]Just traded in my old subtlety...
for a NUANCE![tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top