candrist
01-16-2007, 05:00 PM
I have the following vb code in an excel sheet however I can't cut and paste in the same range.
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim cel As Range
Dim cel2 As Range
Application.EnableEvents = False
If Not Intersect(Me.UsedRange, [M5:M34]) Is Nothing Then
For Each cel In Intersect(Me.UsedRange, [M5:M34]).Cells
Select Case cel
Case "NCN"
Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = 36
Case "ANP", "TYP", "DSH", "OTP", "JOB", "MED", "PAY", "PER", "REL", "RMU", "TMT", "TCI"
Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = 40
Case "END", "ATT", "DEA", "FDS", "FTR", "INS", "MIS", "RIF", "UNS"
Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = 45
Case Else
If Not Intersect(Me.UsedRange, [L5:L35]) Is Nothing Then
For Each cel2 In Intersect(Me.UsedRange, [L5:L35]).Cells
Select Case cel2
Case "RSCH IN"
Range("b" & cel2.Row & ":o" & cel2.Row).Interior.ColorIndex = 34
Case "RSCH OUT"
Range("b" & cel2.Row & ":o" & cel2.Row).Interior.ColorIndex = 42
Case Else
Range("b" & cel2.Row & ":o" & cel2.Row).Interior.ColorIndex = xlNone
End Select
Next
End If
'Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = xlNone
End Select
Next
End If
Application.EnableEvents = True
End Sub
Any way to regain cut and paste?
Regards,
Chris
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Dim cel As Range
Dim cel2 As Range
Application.EnableEvents = False
If Not Intersect(Me.UsedRange, [M5:M34]) Is Nothing Then
For Each cel In Intersect(Me.UsedRange, [M5:M34]).Cells
Select Case cel
Case "NCN"
Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = 36
Case "ANP", "TYP", "DSH", "OTP", "JOB", "MED", "PAY", "PER", "REL", "RMU", "TMT", "TCI"
Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = 40
Case "END", "ATT", "DEA", "FDS", "FTR", "INS", "MIS", "RIF", "UNS"
Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = 45
Case Else
If Not Intersect(Me.UsedRange, [L5:L35]) Is Nothing Then
For Each cel2 In Intersect(Me.UsedRange, [L5:L35]).Cells
Select Case cel2
Case "RSCH IN"
Range("b" & cel2.Row & ":o" & cel2.Row).Interior.ColorIndex = 34
Case "RSCH OUT"
Range("b" & cel2.Row & ":o" & cel2.Row).Interior.ColorIndex = 42
Case Else
Range("b" & cel2.Row & ":o" & cel2.Row).Interior.ColorIndex = xlNone
End Select
Next
End If
'Range("b" & cel.Row & ":o" & cel.Row).Interior.ColorIndex = xlNone
End Select
Next
End If
Application.EnableEvents = True
End Sub
Any way to regain cut and paste?
Regards,
Chris