Results 1 to 9 of 9
  1. #1
    4 Star Lounger
    Join Date
    Oct 2005
    Posts
    599
    Thanks
    1
    Thanked 1 Time in 1 Post

    Work arounds for Cond Formatting in Excel 2003

    Hi all....I am (still) using Excel 2003, with its limited Cond Formatting capacities....I am trying to do some CF using a worksheet change event. This is the code that I am using...I want the cell to colour yellow if I enter ***word........or gray if I enter *word...........whenever I make an entry, I get an error message that says COMPILE ERROR...CASE ELSE OUTSIDE SELECT CASE........can someone tell me what is wrong with the code that I am trying to use? Thank you.....:

    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim oCell As Range
    Dim rng As Range
    Set rng = Intersect(Target, Range("f12:dk275"))
    If Not Intersect(Target, Range("f12:dk275")) Is Nothing Then
    For Each oCell In Intersect(Target, Range("f12:dk275")).Cells
    Select Case UCase(oCell)
    Case "CLOSED"
    oCell.Interior.ColorIndex = 12
    oCell.Font.ColorIndex = 1
    Case Else
    If Left(oCell, 1) = "*" Then
    oCell.Interior.ColorIndex = 15
    oCell.Font.ColorIndex = 1
    Case Else
    If Left(oCell, 1) = "***" Then
    oCell.Interior.ColorIndex = 6
    oCell.Font.ColorIndex = 1
    Else
    oCell.Interior.ColorIndex = xlColorIndexAutomatic
    oCell.Font.ColorIndex = 1
    End Select
    End If
    End Sub

  2. #2
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    First you can only have one Case Else per Select statement.
    Next you did not have a Next oCell for your For Each oCell statement.
    The following is untested code based on what you provided. It at least has the correct structure so you can correct it if it doesn't do exactly what you were after.

    Code:
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
       Dim oCell As Range
       Dim rng As Range
    
       Set rng = Intersect(Target, Range("f12:dk275"))
    
       If Not Intersect(Target, Range("f12:dk275")) Is Nothing Then
    
         For Each oCell In Intersect(Target, Range("f12:dk275")).Cells
            Select Case UCase(oCell)
                  Case "CLOSED"
                      oCell.Interior.ColorIndex = 12
                      oCell.Font.ColorIndex = 1
                  Case Left(oCell, 1) = "*" 
                      oCell.Interior.ColorIndex = 15
                      oCell.Font.ColorIndex = 1
                  Case Left(oCell, 3) = "***"
                      oCell.Interior.ColorIndex = 6
                      Cell.Font.ColorIndex = 1
                  Case Else
                      oCell.Interior.ColorIndex = xlColorIndexAutomatic
                      oCell.Font.ColorIndex = 1
            End Select
    
         Next oCell
    
       End If
    
    End Sub
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

  3. #3
    4 Star Lounger
    Join Date
    Oct 2005
    Posts
    599
    Thanks
    1
    Thanked 1 Time in 1 Post
    Thank you for that information, RG....alwasy appreciate everything that I find here.

  4. #4
    New Lounger
    Join Date
    Feb 2012
    Location
    St. Louis, MO
    Posts
    21
    Thanks
    1
    Thanked 2 Times in 2 Posts
    Hi there,

    I was able to get this code to work (found and altered code located at http://www.mrexcel.com/forum/showthread.php?t=366258) although the only problem is that the Left() function in the Select Case Statement changes the cell color based on the first letter so I was unable to get it to differentiate between * and ***. In the example I've provided below I change the *** option to #. I'm not sure whether this is feasible for your project but hopefully it helps.

    Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim c As Range, d As Range, fc As Long, bc As Long, bf As Boolean, R As Integer

    Set d = Range("A1:B10")
    If d Is Nothing Then Exit Sub

    For Each c In d
    Select Case Left(c, 1)
    Case "C"
    fc = 1: fb = True: bc = 12
    Case "*"
    fc = 1: fb = True: bc = 6
    Case "#"
    fc = 1: fb = True: bc = 16
    Case Else
    fc = 1: fb = False: bc = 0

    End Select
    c.Font.ColorIndex = fc
    c.Font.Bold = fb
    c.Interior.ColorIndex = bc
    Next

    End Sub


    Thanks!

    Ramona

  5. #5
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts

  6. #6
    4 Star Lounger
    Join Date
    Oct 2005
    Posts
    599
    Thanks
    1
    Thanked 1 Time in 1 Post
    Hi Steve....thank you for your reply, altho I can't seem to actually find it...I have checked the cross post at eileenslounge but there is no message orattachment..??..??

  7. #7
    WS Lounge VIP sdckapr's Avatar
    Join Date
    Jul 2002
    Location
    Pittsburgh, Pennsylvania, USA
    Posts
    11,225
    Thanks
    14
    Thanked 342 Times in 335 Posts
    My reply was just an indicator that your question was posed on (at least) 2 different boards that people should review both sites before making any responses so they don't waste time in response if someone else has responded. I believe that both boards have a policy against Cross-posting for this (and other) reasons.

    Steve

  8. #8
    4 Star Lounger
    Join Date
    Oct 2005
    Posts
    599
    Thanks
    1
    Thanked 1 Time in 1 Post
    OK...sorry & thank you...I didn't know there was such a policy.

  9. #9
    Super Moderator RetiredGeek's Avatar
    Join Date
    Mar 2004
    Location
    Manning, South Carolina
    Posts
    9,436
    Thanks
    372
    Thanked 1,457 Times in 1,326 Posts
    I just realized that the code I originally posted had an error. I should have checked for "***" before checking for "*".
    Revised code.
    Code:
    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
       Dim oCell As Range
       Dim rng As Range
    
       Set rng = Intersect(Target, Range("f12:dk275"))
    
       If Not Intersect(Target, Range("f12:dk275")) Is Nothing Then
    
         For Each oCell In Intersect(Target, Range("f12:dk275")).Cells
            Select Case UCase(oCell)
                  Case "CLOSED"
                      oCell.Interior.ColorIndex = 12
                      oCell.Font.ColorIndex = 1
                  Case Left(oCell, 3) = "***" 
                      oCell.Interior.ColorIndex = 15
                      oCell.Font.ColorIndex = 1
                  Case Left(oCell, 1) = "*"
                      oCell.Interior.ColorIndex = 6
                      Cell.Font.ColorIndex = 1
                  Case Else
                      oCell.Interior.ColorIndex = xlColorIndexAutomatic
                      oCell.Font.ColorIndex = 1
            End Select
    
         Next oCell
    
       End If
    
    End Sub
    Last edited by RetiredGeek; 2012-03-15 at 15:52.
    May the Forces of good computing be with you!

    RG

    PowerShell & VBA Rule!

    My Systems: Desktop Specs
    Laptop Specs

Posting Permissions

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