+ Reply to Thread
Results 1 to 4 of 4

Need 2 add second then third code with first code in the Tab View

  1. #1
    nick s
    Guest

    Need 2 add second then third code with first code in the Tab View

    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".

  2. #2
    nick s
    Guest

    RE: Need 2 add second then third code with first code in the Tab View

    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".


  3. #3
    Dave Peterson
    Guest

    Re: Need 2 add second then third code with first code in the Tab View

    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

  4. #4
    nick s
    Guest

    Re: 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
    >


+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1