PDA

View Full Version : Simple VBA question



percy4
03-11-2009, 12:39 PM
Hi all VBA experts,

I am trying to use VBA to apply conditional formatting to column D but the problem is that all cells are affected by my VBA code and just not only column D. I am a total noob at VBA and its probably ridiculously easy to fix it but I still need your help.
Please see code below.
Best regards
Per nilsson

Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = ActiveSheet.Range("D:D").Special(xlCellTypeFormulas, 1)
On Error GoTo 0
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Black"
Cell.Interior.ColorIndex = 1
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case "Blue"
Cell.Interior.ColorIndex = 5
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case "Red"
Cell.Interior.ColorIndex = 3
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

Bob Phillips
03-11-2009, 01:04 PM
Private Sub Worksheet_Change(ByVal Target As Range)

Dim Cell As Range
Dim Rng1 As Range

On Error Resume Next
Set Rng1 = Me.Columns("D").SpecialCells(xlCellTypeFormulas)
On Error GoTo 0

If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If

For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Black"
Cell.Interior.ColorIndex = 1
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case "Blue"
Cell.Interior.ColorIndex = 5
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case "Red"
Cell.Interior.ColorIndex = 3
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next

End Sub

p45cal
03-11-2009, 01:25 PM
I suspect this'll do what you want:Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Rng1 As Range
Set Rng1 = Intersect(Range("D:D"), Target)
If Not Rng1 Is Nothing Then
For Each Cell In Rng1
Select Case Cell.Value
Case vbNullString
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Case "Black"
Cell.Interior.ColorIndex = 1
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case "Blue"
Cell.Interior.ColorIndex = 5
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case "Red"
Cell.Interior.ColorIndex = 3
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2
Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
End Select
Next
End If
End Sub