View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.worksheet.functions
nick s
 
Posts: n/a
Default Need 2 add second then third code with first code in the Tab V

Hi Dave, here are the 2 codes and I will add a third after I get it finished.

CODE 1

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vLetter As String
Dim vColor As Long
Dim yColor As Long
Dim cRange As Range
Dim cell As Range
'***************** check range ****
Set cRange = Intersect(Range("H2:H2000"), Range(Target(1).Address))
If cRange Is Nothing Then Exit Sub
'**********************************

For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 3))
vColor = 0 'default is no color
yColor = xlColorIndexAutomatic
Select Case vLetter
Case "GF7"
vColor = 51
yColor = 2 ' white
Case "GY9"
vColor = 52
yColor = 2 ' white
Case "EV2"
vColor = 46
yColor = xlColorIndexAutomatic
Case "EL5"
vColor = 45
Case "FJ6"
vColor = 4
Case "GY8"
vColor = 12
yColor = 2 ' white
Case "FY1"
vColor = 6
Case "GY3"
vColor = 43
Case "GA4"
vColor = 47
yColor = 2 ' white
Case "FE5"
vColor = 3
Case "GB5"
vColor = 5
yColor = 2 ' white
Case "GK6"
vColor = 9
yColor = 2 ' white
Case "GB2"
vColor = 8
Case "GB7"
vColor = 11
yColor = 2 ' white
Case "GY4"
vColor = 12
Case "GE7"
vColor = 9
yColor = 2 ' white
Case "GF3"
vColor = 10
yColor = 2 ' white
Case "GT2"
vColor = 12
Case "GT8"
vColor = 52
yColor = 2 ' white
Case "EW1"
vColor = 2
Case "TX9"
vColor = 1
yColor = 2 ' white
Case "FC7"
vColor = 54
yColor = 2 ' white

End Select
Application.EnableEvents = False 'should be part of Change macro
cell.Interior.ColorIndex = vColor
cell.Font.ColorIndex = yColor
Application.EnableEvents = True 'should be part of Change macro
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor
' use Text instead of Interior if you prefer
End Sub


Code 2 -

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vLetter As String
Dim vColor As Long
Dim yColor As Long
Dim cRange As Range
Dim cell As Range
'***************** check range ****
Set cRange = Intersect(Range("I2:I2000"), Range(Target(1).Address))
If cRange Is Nothing Then Exit Sub
'**********************************

For Each cell In Target
vLetter = UCase(Left(cell.Value & " ", 4))
vColor = 0 'default is no color
yColor = xlColorIndexAutomatic
Select Case vLetter
Case "M6F7"
vColor = 51
yColor = 2 ' white
Case "P6F7"
vColor = 51
yColor = 2 ' white
Case "M6XV"
vColor = 46
yColor = xlColorIndexAutomatic
Case "P6Y3"
vColor = 12
yColor = 2 ' white
Case "P6T7"
vColor = 40
Case "P6XA"
vColor = 47
yColor = 2 ' white
Case "P6B5"
vColor = 5
yColor = 2 ' white
Case "H2B5"
vColor = 5
yColor = 2 ' white
Case "M2B5"
vColor = 5
yColor = 2 ' white
Case "M6B5"
vColor = 5
yColor = 2 ' white
Case "P6X9"
vColor = 1
yColor = 2 ' white
Case "P3X9"
vColor = 1
yColor = 2 ' white
Case "M2X9"
vColor = 1
yColor = 2 ' white
Case "M6X9"
vColor = 1
yColor = 2 ' white
End Select
Application.EnableEvents = False 'should be part of Change macro
cell.Interior.ColorIndex = vColor
cell.Font.ColorIndex = yColor
Application.EnableEvents = True 'should be part of Change macro
Next cell
'Target.Offset(0, 1).Interior.colorindex = vColor
' use Text instead of Interior if you prefer
End Sub


I would add code 3 but I haven't finished it yet.

thanks,
Nick



"Dave Peterson" wrote:

I think you're going to have to explain what you want to do and you may want to
post the code you're using.

There's lots of different things that can go in that worksheet module.

nick s wrote:

Maybe it would be easier to understand this instead.

I am trying to combine 2 different MACROS together or keep them sperate but
get them both to run. I cannot find a way to paste the second to the first
and not get an ERROR when I run it.

"nick s" wrote:

I am needing to add a second, third and maybe a fourth code (MACRO) to the
exisiting code (MACRO) I have been using, this code is in the Sheet Tab "View
Code".


--

Dave Peterson