Two Codes are not working simaltaniously Plz Help

[Waqar]

I have two codes one for Highlighted entire row and coloumn and second is for protect the cell after each entry. I want to use both at the same time i paste both in worksheet then cell is lock but row and coloumn not highlighted Plz help me out.

Code 1 for Highlight

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer
'// Amended routine found on this Web site
'// Note: Don't use IF you have Conditional
'// formating that you want to keep!

'// On error resume in case
'// user selects a range of cells
On Error Resume Next
iColor = Target.Interior.ColorIndex
'Leave On Error ON for Row offset errors

If iColor < 0 Then
iColor = 36
Else
iColor = iColor + 1
End If

'// Need this test incase Font color is the same
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1

Cells.FormatConditions.Delete

'// Horizontal color banding
With Range("A" & Target.Row, Target.Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With

'// Vertical color banding
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With

End Sub

Code 2 For Lock Cell

Private Sub Worksheet_Change(ByVal Target As Range)
With Me
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeConstants).Locked = True
.Protect
End With
End Sub



Regards
Waqar

 

[Andrew Poulsom]

What happens if you comment out this line?

On Error Resume Next

You probably need to unprotect/protect the worksheet in the SelectionChange event procedure.

 

[Waqar]

Thanks Alot Andrew

i did what u say but error still persist ........................ plz Help me out.......

Regards
waqar

 

[Andrew Poulsom]

What happened when you you removed the error trap? What did you do in an attempt to fix any errors?

 

[Waqar]

Thanks Alot Andrew
I am not very expert in coding............ I try few thing including your suggestion but nothing work.....Yellow line appear every time...... Plz elaborate little more.
if you rewright code then i beleive it will work.

Regards

 

[Andrew Poulsom]

What code did you try, which line became yellow and what was the error?

 

[Waqar]

Thanks Alot
I try This

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim iColor As Integer
'// Amended routine found on this Web site
'// Note: Don't use IF you have Conditional
'// formating that you want to keep!

'// On error resume in case
'// user selects a range of cells
'// On Error Resume Next
iColor = Target.Interior.ColorIndex
'Leave On Error ON for Row offset errors

If iColor < 0 Then
iColor = 36
Else
iColor = iColor + 1
End If

'// Need this test incase Font color is the same
If iColor = Target.Font.ColorIndex Then iColor = iColor + 1

Cells.FormatConditions.Delete

'// Horizontal color banding
With Range("A" & Target.Row, Target.Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With

'// Vertical color banding
With Range(Target.Offset(1 - Target.Row, 0).Address & ":" & Target.Offset(-1, 0).Address) 'Rows(Target.Row)
.FormatConditions.Add Type:=2, Formula1:="TRUE"
.FormatConditions(1).Interior.ColorIndex = iColor
End With



With Me
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeConstants).Locked = True
.Protect
End With

End Sub

BOLD Line is yellow

Regards

 

[Andrew Poulsom]

Remove this section which is already in your Worksheet_Change event procedure:

With Me
.Unprotect
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeConstants).Locked = True
.Protect
End With

Then at the beginning of your Worksheet_SelectionChange event procedure put:

Me.Unprotect

and at the end put:

Me.Protect

 

[Waqar]

Thanks Andrew
I did what u say ...........I want one time entry in each cell after that it should lock ....but after ur suggestion it always lock even cell is empty so i have to unlock for every entry.
It should accept first entry and then lock.

Regards

 

[Andrew Poulsom]

Please post your current VBA code.