Simple VBA question

[percy4]

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]

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]

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