ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,832
- Office Version
- 2007
- Platform
- Windows
Hi,
I am using this working code shown below,
It works like this.
I complete each cell in my new row.
In cell B7 i enter 17 characters,the 10th character is shown in a red font.
Cell E has a date automatically entered due to this 10th character.
If for any reason i decide to delete row 7 at a later stage, then row 8 now becomes row 7.
Then i notice that the 10th character that was red when it was in row 8 is now black like all the other 16 characters.
I know it has done this because it was originaly applied on a change event code but is there a workaround i can apply that it isnt affected should row 7 get deleted thus when row 8 is then row 7 it stays red.
Many thanks
I am using this working code shown below,
It works like this.
I complete each cell in my new row.
In cell B7 i enter 17 characters,the 10th character is shown in a red font.
Cell E has a date automatically entered due to this 10th character.
If for any reason i decide to delete row 7 at a later stage, then row 8 now becomes row 7.
Then i notice that the 10th character that was red when it was in row 8 is now black like all the other 16 characters.
I know it has done this because it was originaly applied on a change event code but is there a workaround i can apply that it isnt affected should row 7 get deleted thus when row 8 is then row 7 it stays red.
Many thanks
Code:
Private Sub Worksheet_Change(ByVal Target As Range) Dim c As Range
On Error GoTo AllowEvents
Application.EnableEvents = False
Application.ScreenUpdating = False
For Each c In Target
If c.Row > 6 And c.Column < 9 And Not IsEmpty(c) Then
If Not c.HasFormula Then
c.Value = UCase(c.Value)
Else
c.Formula = Replace(c.Formula, "=", "=UPPER(") & ")"
End If
End If
Next c
If Target.CountLarge > 1000 Then GoTo AllowEvents
If Not Intersect(Target, Range("B:B")) Is Nothing Then
For Each c In Intersect(Target, Range("B:B"))
If c.Row > 6 Then
If Len(c.Value) <> 17 And Len(c.Value) > 0 Then
MsgBox "VIN MUST BE 17 CHARACTERS", vbCritical, "VIN CHARACTER COUNT MESSAGE"
c.Value = ""
c.Select
GoTo AllowEvents
Else
c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
End If
End If
Next c
If Range("B7") = "" Then Range("E7") = ""
End If
AllowEvents:
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub