Consulting

Results 1 to 18 of 18

Thread: From KBase

  1. #1

    From KBase

    I have the following code so far that someone else wrote. It is on the right track, I think, but I am too in-experienced in VBA to troubleshoot it. The code will only work if I re-confirm the formulas in Rng1(E5:BD103). How can I make it or my worksheet automatic?

    FYI: There will be about 9 more cases of names and formats besides "Luis"

    [VBA] Option Compare Text 'A=a, B=b, ... Z=z
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Rng1 As Range, iCol As Long, fCol
    Set Rng1 = Intersect(Range("E5:BD103"), Target)
    If (Rng1 Is Nothing) Or (Target.Count <> 1) Then Exit Sub
    Select Case Target.Value
    Case vbNullString
    iCol = 0
    fCol = 0
    Case "Luis"
    iCol = 3
    fCol = 8
    Case Else
    iCol = 10
    fCol = 10
    End Select
    Target.Interior.ColorIndex = iCol
    Target.Font.ColorIndex = fCol
    End Sub[/VBA]
    Last edited by orbea_adam; 06-12-2007 at 01:25 PM.

  2. #2
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    What do you mean by re-confirm? And what do you want it to do?
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  3. #3
    By "re-confirm" I mean F2 in a cell and Enter.

    All I'm trying to do is get an interior color and font color if the cell value is a certain text...

  4. #4
    Administrator
    2nd VP-Knowledge Base
    VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Are you trying to have something like conditional formatting for formulas? Using that code won't change the cells that have formulas in them (Even if the cell with the formula changes) unless you change the formula or do what you said (F2 then Enter).

    But, then again, I'm not sure what you're doing. Can you provide a sample workbook?




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  5. #5
    Joseph, Thank you for your reply! Can you suggest a different code?

    So that we're up to speed:
    ---Range E5:BD103 contains a VLOOKUP in each cell, the cells are never typed over and the formulas stay intact 100% of the time
    ---The result of the VLOOKUP is a person's name, 10 different names possible
    ---My formatting will depend on that name, I need interior color and font color

  6. #6
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    I thought that KB entry looked familiar! You're missing a key element there:
    [vba]Option Compare Text 'A=a, B=b, ... Z=z
    Option Explicit

    Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell As Range
    Dim Rng1 As Range

    On Error Resume Next
    Set Rng1 = ActiveSheet.Cells.SpecialCells(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 "Tom", "Joe", "Paul"
    Cell.Interior.ColorIndex = 3
    Cell.Font.Bold = True
    Case "Smith", "Jones"
    Cell.Interior.ColorIndex = 4
    Cell.Font.Bold = True
    Case 1, 3, 7, 9
    Cell.Interior.ColorIndex = 5
    Cell.Font.Bold = True
    Case 10 To 25
    Cell.Interior.ColorIndex = 6
    Cell.Font.Bold = True
    Case 26 To 99
    Cell.Interior.ColorIndex = 7
    Cell.Font.Bold = True
    Case Else
    Cell.Interior.ColorIndex = xlNone
    Cell.Font.Bold = False
    End Select
    Next

    End Sub[/vba]
    Most importantly
    [vba]Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)[/vba]
    And
    [vba]If Rng1 Is Nothing Then
    Set Rng1 = Range(Target.Address)
    Else
    Set Rng1 = Union(Range(Target.Address), Rng1)
    End If[/vba]
    And you should loop through the cells like the code shows. Just change the Case xxxx to all your conditions.

    By the way, if you have formulas other than E5:BD103 and you are looking to ONLY have those cells change, then you can change:
    [vba]Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
    ' To the following
    Set Rng1 = Range("E5:BD103")

    ' And completely remove
    If Rng1 Is Nothing Then
    Set Rng1 = Range(Target.Address)
    Else
    Set Rng1 = Union(Range(Target.Address), Rng1)
    End If

    ' And keep everything else intact.[/vba]

    Actually, you probably don't have to even bother with 'Target'...but I'm not sure.




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  7. #7
    Joseph,
    I'm sorry, but this is mostly Chinese to me. Will you do me a huge favor and just get me started with my first Case? I'd be in debt to you and the rest of the board forever!
    Adam

  8. #8
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Quote Originally Posted by orbea_adam
    Joseph,
    I'm sorry, but this is mostly Chinese to me. Will you do me a huge favor and just get me started with my first Case? I'd be in debt to you and the rest of the board forever!
    Adam
    Hmmm...sounds like a bargain to me

    Delete the commented out lines if you wish...I kept them there for your reference:
    [VBA]Private Sub Worksheet_Change(ByVal Target As Range)

    Dim Cell As Range
    Dim Rng1 As Range
    Dim iCol As Long, fCol As Long

    On Error Resume Next
    ' Set Rng1 = ActiveSheet.Cells.SpecialCells(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
    Set Rng1 = Range("E5:BD103")
    For Each Cell In Rng1
    Select Case Cell.Value
    Case vbNullString
    iCol = 0
    fCol = 0
    Case "Luis"
    iCol = 3
    fCol = 8
    ' Case "Smith", "Jones"
    ' Cell.Interior.ColorIndex = 4
    ' Cell.Font.Bold = True
    ' Case 1, 3, 7, 9
    ' Cell.Interior.ColorIndex = 5
    ' Cell.Font.Bold = True
    ' Case 10 To 25
    ' Cell.Interior.ColorIndex = 6
    ' Cell.Font.Bold = True
    ' Case 26 To 99
    ' Cell.Interior.ColorIndex = 7
    ' Cell.Font.Bold = True
    Case Else
    iCol = 10
    fCol = 10
    End Select
    Cell.Interior.ColorIndex = iCol
    Cell.Font.ColorIndex = fCol
    Next

    End Sub[/VBA]

    Let me know how it goes...and I'll let you know how much you owe me and VBAX




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  9. #9
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    I love it when they come back and help solve other folks problems.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  10. #10
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Me too I like watching people learn.




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  11. #11
    Thanks again Joseph! I'll give it a shot at work tomorrow...

  12. #12
    Moderator VBAX Wizard Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    5,059
    Location
    Quote Originally Posted by malik641
    Me too I like watching people learn.
    Well don't watch me too closely, cause I'm as thick as two planks.
    Remember To Do the Following....
    Use [Code].... [/Code] tags when posting code to the thread.
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  13. #13
    Joseph,
    I no longer have to F2 and Enter each cell, but I do have to in at least one cell, which executes the code on the entire range. Can we get around that and make it auto for the entire range?

    Also, where do I find the color index numbers?
    Adam

  14. #14
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,453
    Location
    Look up Colorindex in VBA Help.
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

  15. #15
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    Post your workbook please....it would make this sooo much easier...just a sample of what your trying to do.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  16. #16
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Quote Originally Posted by orbea_adam
    Joseph,
    I no longer have to F2 and Enter each cell, but I do have to in at least one cell, which executes the code on the entire range. Can we get around that and make it auto for the entire range?
    When do you need it to execute?
    Do you have formulas that refer to other worksheets?

    And as Steve said, please supply a sample workbook. This should make things much quicker.




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

  17. #17
    I got it figured out. Thank you very much for your help! Where do I have the donuts delivered?
    Adam

  18. #18
    Administrator
    2nd VP-Knowledge Base VBAX Master malik641's Avatar
    Joined
    Jul 2005
    Location
    Florida baby!
    Posts
    1,533
    Location
    Glad you got it worked out What did you end up doing, anyway?

    Quote Originally Posted by orbea_adam
    Where do I have the donuts delivered?
    I'd like to request "Pollo a la milanesa". Por favor




    New to the forum? Check out our Introductions section to get to know some of the members here. Feel free to tell us a little about yourself as well.

Posting Permissions

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