copy and paste problem

F

Fred Kruger

I have created a work sheet which using the workbook change subroutine
changes the background colour of cells and edits the content if certain
letters or number are added.

This works ok until I copy and paste into this range and then the background
changes from the selected colour to pink for all the pasted cells

I need to replicate in the range certain blocks of data and dont want to
have to type it in each time is there any way I can keep the copied cells
format as I paste them into the automated range.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
'Sets the range of cells for the code to work if a cell other than the range
is altered
'the sub is exited.

Set Target = Intersect(Target, Range("B21:h21", "b700:h700"))
If Target Is Nothing Then
Exit Sub

'If the cells in the range equal this criteria then they are changed
accordingly
'Weekly Rest Day
ElseIf Target = "RD" Then

With Target
.Interior.ColorIndex = 17
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Annual Leave
ElseIf Target = "AL" Then

With Target
.Interior.ColorIndex = 4
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Bank Holiday Leave
ElseIf Target = "BH" Then

With Target
.Interior.ColorIndex = 24
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Duty Elsewhere
ElseIf Target = "DE" Then

With Target
.Interior.ColorIndex = 15
.Font.ColorIndex = 11
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Football
ElseIf Target = "FB" Then

With Target
.Interior.ColorIndex = 27
.Font.ColorIndex = 25
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Lieu Leave
ElseIf Target = "LL" Then

With Target
.Interior.ColorIndex = 33
.Font.ColorIndex = 1
.Font.Bold = True

End With


'If the cells in the range equal this criteria then they are changed
accordingly
'CADRE cover
ElseIf Target = "n" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 22
.Font.ColorIndex = 6
.Font.Bold = True

End With


'If the cells in the range equal this criteria then they are changed
accordingly
'CADRE cover
ElseIf Target = "c" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 22
.Font.ColorIndex = 2
.Font.Bold = True

End With


'If the cells in the range equal this criteria then they are changed
accordingly
'CADRE cover
ElseIf Target = "e" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 22
.Font.ColorIndex = 1
.Font.Bold = True

End With


'If the cells in the range equal this criteria then they are changed
accordingly
'PACE cover
ElseIf Target = "x" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 3
.Font.ColorIndex = 2
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Weekly Rest Day
ElseIf Target = "rd" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 17
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Annual Leave
ElseIf Target = "al" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 4
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Bank Holiday Leave
ElseIf Target = "bh" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 24
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Paternity Leave
ElseIf Target = "pl" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 7
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Duty Elsewhere
ElseIf Target = "de" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 15
.Font.ColorIndex = 11
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Football
ElseIf Target = "fb" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 27
.Font.ColorIndex = 25
.Font.Bold = True

End With

'If the cells in the range equal this criteria then they are changed
accordingly
'Lieu Leave
ElseIf Target = "ll" Then

Target = UCase(Target)
With Target
.Interior.ColorIndex = 33
.Font.ColorIndex = 1
.Font.Bold = True

End With
ElseIf Target = "8" Then

Target = "8x5"
With Target
.Interior.ColorIndex = 2
.Font.ColorIndex = 1
.Font.Bold = False
End With
ElseIf Target = "10" Then

Target = "10x7"
With Target
.Interior.ColorIndex = 2
.Font.ColorIndex = 1
.Font.Bold = False
End With
ElseIf Target = "12" Then

Target = "12x9"
With Target
.Interior.ColorIndex = 2
.Font.ColorIndex = 1
.Font.Bold = False
End With
ElseIf Target = "1" Then

Target = "1x9"
With Target
.Interior.ColorIndex = 2
.Font.ColorIndex = 1
.Font.Bold = False
End With
'If the cells in the range equal this criteria then they are changed
accordingly
'Empty Cells
ElseIf Target = "" Then

With Target
.Interior.ColorIndex = 2
.Font.ColorIndex = 1
.Font.Bold = True

End With

'If anything other than this criteria is entered then the cells are left
unformatted.

End If
End Sub

Here is the code I am currently using>>>>>
 
J

Joel

Here is a better way of writting your code. I converted the first few ifelse
sections to demonstrate how to use the Case Select

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
On Error Resume Next
'Sets the range of cells for the code to work if a cell other than the range
'is altered
'the sub is exited.

Set Target = Intersect(Target, Range("B21:h21", "b700:h700"))

If Target Is Nothing Then
Exit Sub

'If the cells in the range equal this criteria
'then they are changed accordingly
'Weekly Rest Day
With Target

Select Case Target

Case Target = "RD"

.Interior.ColorIndex = 17
.Font.ColorIndex = 1
.Font.Bold = True

Case Target = "AL"

'If the cells in the range equal this
'criteria then they are changed accordingly
'Annual Leave

.Interior.ColorIndex = 4
.Font.ColorIndex = 1
.Font.Bold = True


'If the cells in the range equal this criteria
' then they are changed accordingly
'Bank Holiday Leave
Case Target = "BL"

.Interior.ColorIndex = 24
.Font.ColorIndex = 1
.Font.Bold = True

'If the cells in the range equal this _
' criteria then they are changed accordingly
'Duty Elsewhere
Case Target = "DE"
.Interior.ColorIndex = 15
.Font.ColorIndex = 11
.Font.Bold = True
End Select
End With
End If

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Pass condition formatting across worksheets via vba. 0
"ElseIf c.Value = "X_Clear" Then" and "...Target.Cells.Count > 1"don't work 4
Junp start my Select Case Macro 12
Change_Event troubles, no error & no work. 6
Modify sub to work on cells with formulas 2
Worksheet_Change Woes 6
Highlight a cell after update in a specific range 2
Changing Font Color to White if Background is Black 2

Top