ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Validation Help (https://www.excelbanter.com/excel-discussion-misc-queries/95997-validation-help.html)

teeb

Validation Help
 

I have various sheets that have columns of data.

What I want to do is make another sheet that copies the data from
certain columns and inserts them in the new sheet.

I've tried a simple =Sheet1!A1 then dragged the formula down the rows.
My problem is that I have a simple formula for changing the background
color of the cell based on the input, but the in the copied sheet the
background doesn't change.

Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range

Set rng = Intersect(Target, Range("A1:Z5000"))
If rng Is Nothing Then
Exit Sub
Else
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case "h"
cl.Interior.ColorIndex = 3
Case "f"
cl.Interior.ColorIndex = 4
Case "ba"
cl.Interior.ColorIndex = 32
Case "bh"
cl.Interior.ColorIndex = 33
Case "h/2"
cl.Interior.ColorIndex = 44
Case "f/2"
cl.Interior.ColorIndex = 35
Case "s"
cl.Interior.ColorIndex = 15
Case "l"
cl.Interior.ColorIndex = 6
Case ""
cl.Interior.ColorIndex = none
Case "c"
cl.Interior.ColorIndex = 7

Case Else
Exit Sub
End Select
Next cl
End If

Any ideas?


--
teeb
------------------------------------------------------------------------
teeb's Profile: http://www.excelforum.com/member.php...o&userid=13172
View this thread: http://www.excelforum.com/showthread...hreadid=555498


Norman Jones

Validation Help
 
Hi Teeb,

Try:

'=============
Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range
Dim cl As Range
Dim SH2 As Worksheet
Dim rng2 As Range

Set rng = Intersect(Target, Range("A1:Z5000"))
If rng Is Nothing Then
Exit Sub
End If

Set SH2 = ThisWorkbook.Sheets("Sheet2") '<<==== CHANGE

For Each cl In rng.Cells
Set rng2 = SH2.Range(cl.Address)
Select Case cl.Text
Case "h"
cl.Interior.ColorIndex = 3
rng2.Interior.ColorIndex = 3
Case "f"
cl.Interior.ColorIndex = 4
rng2.Interior.ColorIndex = 4
Case "ba"
cl.Interior.ColorIndex = 32
rng2.Interior.ColorIndex = 32
Case "bh"
cl.Interior.ColorIndex = 33
rng2.Interior.ColorIndex = 33
Case "h/2"
cl.Interior.ColorIndex = 44
rng2.Interior.ColorIndex = 44
Case "f/2"
cl.Interior.ColorIndex = 35
rng2.Interior.ColorIndex = 35
Case "s"
cl.Interior.ColorIndex = 15
rng2.Interior.ColorIndex = 15
Case "l"
cl.Interior.ColorIndex = 6
rng2.Interior.ColorIndex = 6
Case ""
cl.Interior.ColorIndex = xlNone
rng2.Interior.ColorIndex = xlNone
Case "c"
cl.Interior.ColorIndex = 7
rng2.Interior.ColorIndex = 7

Case Else
cl.Interior.ColorIndex = xlNone
rng2.Interior.ColorIndex = xlNone
End Select
Next cl
End Sub
'<<=============


---
Regards,
Norman



"teeb" wrote in message
...

I have various sheets that have columns of data.

What I want to do is make another sheet that copies the data from
certain columns and inserts them in the new sheet.

I've tried a simple =Sheet1!A1 then dragged the formula down the rows.
My problem is that I have a simple formula for changing the background
color of the cell based on the input, but the in the copied sheet the
background doesn't change.

Private Sub Worksheet_Change(ByVal Target As Range)
' Conditional Formatting for more than 3 conditions

Dim rng As Range

Set rng = Intersect(Target, Range("A1:Z5000"))
If rng Is Nothing Then
Exit Sub
Else
Dim cl As Range
For Each cl In rng
Select Case cl.Text
Case "h"
cl.Interior.ColorIndex = 3
Case "f"
cl.Interior.ColorIndex = 4
Case "ba"
cl.Interior.ColorIndex = 32
Case "bh"
cl.Interior.ColorIndex = 33
Case "h/2"
cl.Interior.ColorIndex = 44
Case "f/2"
cl.Interior.ColorIndex = 35
Case "s"
cl.Interior.ColorIndex = 15
Case "l"
cl.Interior.ColorIndex = 6
Case ""
cl.Interior.ColorIndex = none
Case "c"
cl.Interior.ColorIndex = 7

Case Else
Exit Sub
End Select
Next cl
End If

Any ideas?


--
teeb
------------------------------------------------------------------------
teeb's Profile:
http://www.excelforum.com/member.php...o&userid=13172
View this thread: http://www.excelforum.com/showthread...hreadid=555498





All times are GMT +1. The time now is 06:43 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com