PDA

View Full Version : Simple VBA-code question



percy4
04-15-2009, 03:49 AM
Hi VBA experts,

I've got this code and I wan't to set my range to two columns (J & M) but I can't get it to work. Perferrably I would like to set the range like (k2:K300 etc.) to make the code run as smooth as possible. Pls help me.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Rng1 As Range
Set Rng1 = Intersect(Range("J2:J300"), 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
Cell.Font.ColorIndex = 1
Cell.Font.Name = "arial"

Case -3000 To 0
Cell.Interior.ColorIndex = 3
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case 1 To 14
Cell.Interior.ColorIndex = 6
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1

Case 15 To 1000
Cell.Interior.ColorIndex = 10
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Cell.Font.Name = "arial narrow"
Cell.Font.ColorIndex = 1
End Select
Next
End If
End Sub

Simon Lloyd
04-15-2009, 04:16 AM
Well which is it? J & M, J:M or K?

percy4
04-15-2009, 05:24 AM
Sorry, It should be J and M.

Regards
Per

Bob Phillips
04-15-2009, 06:24 AM
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
Dim Rng1 As Range
Set Rng1 = Intersect(Range("J2:J300, M2:M300"), 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
Cell.Font.ColorIndex = 1
Cell.Font.Name = "arial"

Case -3000 To 0
Cell.Interior.ColorIndex = 3
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case 1 To 14
Cell.Interior.ColorIndex = 6
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 1

Case 15 To 1000
Cell.Interior.ColorIndex = 10
Cell.Font.Name = "arial narrow"
Cell.Font.Bold = True
Cell.Font.ColorIndex = 2

Case Else
Cell.Interior.ColorIndex = xlNone
Cell.Font.Bold = False
Cell.Font.Name = "arial narrow"
Cell.Font.ColorIndex = 1
End Select
Next
End If
End Sub

DannyUk
04-16-2009, 02:02 PM
Might be able to reduce the code a bit


Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cl As Range
Dim Rng1 As Range

Dim CI As Long
Dim FCI As Long

Dim Bld As String
Dim Nm As String

Set Rng1 = Intersect(Range("J2:J300, M2:M300"), Target)
If Not Rng1 Is Nothing Then
For Each Cl In Rng1
Select Case Cl.Value
Case vbNullString: CI = 0: Bld = False: FCI = 1: Nm = "Arial"
Case -3000 To 0: CI = 3: Bld = True: FCI = 2: Nm = "arial narrow"
Case 1 To 14: CI = 6: Bld = True: FCI = 1: Nm = "arial narrow"
Case 15 To 1000: CI = 10: Bld = True: FCI = 2: Nm = "arial narrow"
Case Else: CI = 0: Bld = False: FCI = 1: Nm = "arial narrow"
End Select


With Cl
.Interior.ColorIndex = CI
.Font.Bold = Bld
.Font.ColorIndex = FCI
.Font.Name = Nm
End With
Next
End If
End Sub


Danny

Bob Phillips
04-16-2009, 02:18 PM
I wouldn't. You have obfuscated the code, which was clear and readable, for what, a few characters less.

DannyUk
04-16-2009, 02:23 PM
Guess you're right Xld

Danny

mdmackillop
04-18-2009, 11:57 AM
Hi Danny,
FYI, use the green VBA button to add tags to format as shown, rather than the Code tags.
Regards
MD

DannyUk
04-18-2009, 12:05 PM
Hi Danny,
FYI, use the green VBA button to add tags to format as shown, rather than the Code tags.
Regards
MD

Hi mdmackillop,

Didn't spot that. Will do in future

Danny