PDA

View Full Version : From KBase



orbea_adam
06-12-2007, 01:15 PM
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"

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

Bob Phillips
06-12-2007, 01:43 PM
What do you mean by re-confirm? And what do you want it to do?

orbea_adam
06-12-2007, 02:49 PM
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...

malik641
06-12-2007, 04:26 PM
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?

orbea_adam
06-12-2007, 04:33 PM
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

malik641
06-12-2007, 04:57 PM
I thought that KB entry looked familiar! You're missing a key element there:
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
Most importantly
Set Rng1 = ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas, 1)
And
If Rng1 Is Nothing Then
Set Rng1 = Range(Target.Address)
Else
Set Rng1 = Union(Range(Target.Address), Rng1)
End If
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:
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.

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

orbea_adam
06-12-2007, 06:31 PM
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

malik641
06-12-2007, 06:52 PM
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 :think:

Delete the commented out lines if you wish...I kept them there for your reference:
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

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

lucas
06-12-2007, 07:01 PM
I love it when they come back and help solve other folks problems.

malik641
06-12-2007, 07:40 PM
Me too :) I like watching people learn.

orbea_adam
06-12-2007, 10:08 PM
Thanks again Joseph! I'll give it a shot at work tomorrow...

Aussiebear
06-13-2007, 02:21 AM
Me too :) I like watching people learn.

Well don't watch me too closely, cause I'm as thick as two planks.

orbea_adam
06-13-2007, 08:05 AM
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

Bob Phillips
06-13-2007, 08:12 AM
Look up Colorindex in VBA Help.

lucas
06-13-2007, 08:12 AM
Post your workbook please....it would make this sooo much easier...just a sample of what your trying to do.

malik641
06-13-2007, 09:30 AM
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.

orbea_adam
06-13-2007, 09:32 AM
I got it figured out. Thank you very much for your help! Where do I have the donuts delivered?
Adam

malik641
06-13-2007, 09:54 AM
Glad you got it worked out :) What did you end up doing, anyway?


Where do I have the donuts delivered?
I'd like to request "Pollo a la milanesa". Por favor :yes