Selection change event code now to be used on change event code issue

I

ipbr21054

Well-known Member
Joined
Nov 16, 2010
Messages
5,226
Office Version
  1. 2007
Platform
  1. Windows
Hi,

I have placed a piece of working code from one worksheet into a new worksheet but now doesnt work work for me.
The worksheet it was taken from was a selection change event "code also works still" where now the worksheet its now in is a change event "doesnt work"

Column B will have a 17 character value entered into the cell.
The 10th character will be shown in RED.
Depending on the 10th character the value then in cell column I will also be RED.

Can you advise what i missed or need to add so no matter what cell etc i am in the code below will make sure and the 10th character in column B will be RED
The selection change code worked only for cell B8 as a new row was added each time.

I changed the range B8 to B8:B50 but still no joy

Code in place is shown below

Rich (BB code): 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim C As Range
    Dim LR As Long
    
    Range("B8").Characters(Start:=10, Length:=1).Font.Color = -16776961
    Application.EnableEvents = False
    Select Case Mid(Range("B8").Value, 10, 1)
    Case Is = "S"
            Range("I8").Value = "1995"
    Case Is = "T"
            Range("I8").Value = "1996"
    Case Is = "V"
            Range("I8").Value = "1997"
    Case Is = "W"
            Range("I8").Value = "1998"
    Case Is = "X"
            Range("I8").Value = "1999"
    Case Is = "Y"
            Range("I8").Value = "2000"
    Case Is = "1"
            Range("I8").Value = "2001"
    Case Is = "2"
            Range("I8").Value = "2002"
    Case Is = "3"
            Range("I8").Value = "2003"
    Case Is = "4"
            Range("I8").Value = "2004"
    Case Is = "5"
            Range("I8").Value = "2005"
    Case Is = "6"
            Range("I8").Value = "2006"
    Case Is = "7"
            Range("I8").Value = "2007"
    Case Is = "8"
            Range("I8").Value = "2008"
    Case Is = "9"
            Range("I8").Value = "2009"
    Case Is = "A"
            Range("I8").Value = "2010"
    Case Is = "B"
            Range("I8").Value = "2011"
    Case Is = "C"
            Range("I8").Value = "2012"
    Case Is = "D"
            Range("I8").Value = "2013"
    Case Is = "E"
            Range("I8").Value = "2014"
    Case Is = "F"
            Range("I8").Value = "2015"
    Case Is = "G"
            Range("I8").Value = "2016"
    Case Is = "H"
            Range("I8").Value = "2017"
    Case Is = "J"
            Range("I8").Value = "2018"
    Case Is = "K"
            Range("I8").Value = "2019"
    End Select
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range("I8").Font.Color = vbRed

    LR = Cells(Rows.Count, "A").End(xlUp).Row
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
        
    For Each C In Target
        If C.Row > 6 And C.Column < 11 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("B8:B" & LR)) Is Nothing Then
    
        For Each C In Intersect(Target, Range("B8:B" & LR))
            If (C.Row > 6) And (C.Row < LR) 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
            Else
                  C.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
            End If
        Next C
               If Range("B8") = "" Then Range("E8") = ""
    End If
AllowEvents:

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range("B8").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
    
    Range("B8").Font.Size = 18
    Range("B8").Font.Bold = True
    Range("B8").HorizontalAlignment = xlCenter
    Range("B8").VerticalAlignment = xlCenter
    Range("B8").Font.Name = "Calibri"
    Range("B8").Borders.LineStyle = xlContinuous
    Range("B8").Borders.Weight = xlThin

End Sub
 
Sort by date Sort by votes
Your code does work & i found the issue of which its now sorted.

I have all the values in column B as black text.
If i delete any row i then see cell B8 have the 10th character turn from black to red.

Below is a change event for that worksheet of which i see a few options of Font.ColorIndex = 3

Can you advise what these three lines of code do as i think this is an issue and not sure what to delete / edit etc because 3 = RED

VBA Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim c As Range
    Dim LR As Long
    LR = Cells(Rows.Count, "A").End(xlUp).Row
    On Error GoTo AllowEvents
    
    Application.EnableEvents = False
    Application.ScreenUpdating = False
        
    For Each c In Target
        If c.Row > 6 And c.Column < 11 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("B8:B" & LR)) Is Nothing Then
    
        For Each c In Intersect(Target, Range("B8:B" & LR))
            If (c.Row > 6) And (c.Row < LR) 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
            Else
                  c.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
            End If
        Next c
               If Range("B8") = "" Then Range("I8") = ""
    End If
AllowEvents:

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range("B8").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
    
    Range("B8").Font.Size = 18
    Range("B8").Font.Bold = True
    Range("B8").HorizontalAlignment = xlCenter
    Range("B8").VerticalAlignment = xlCenter
    Range("B8").Font.Name = "Calibri"
    Range("B8").Borders.LineStyle = xlContinuous
    Range("B8").Borders.Weight = xlThin

End Sub
 
Upvote 0

Excel Facts

What do {} around a formula in the formula bar mean?
{Formula} means the formula was entered using Ctrl+Shift+Enter signifying an old-style array formula.
Why are you using worksheet_change ?
- is the user changing the values MANUALLY ?
 
Upvote 0
Maybe the code was on a command button on the worksheet ?
There isnt a button anymore so ive deleted that redundant code.

Seems to work fine now.



Can you advise a basic code to now apply red to the 10th character in column B8:B33 as all are currently black

Thanks for your help / time
 
Upvote 0
ipbr21054 said:
Can you advise a basic code to now apply red to the 10th character in column B8:B33 as all are currently black
Click to expand...

VBA Code: 
    Dim cel As Range
    For Each cel In Range("B8:B33")
        If Len(cel) > 9 Then cel.Characters(Start:=10, Length:=1).Font.ColorIndex = 3
    Next cel
 
Upvote 0
Morning & thanks for the above it worked a treat so now completed.

Just a side note.
I am keeping a record of useful codes to use in the future.

Should i not wish to spicify a range like B8:B33 but have the code just work for B8 & down the page using the ("B8" & Rows.Count).End(xlUp)
how would this be written.

Have a nice day
 
Upvote 0
ipbr21054 said:
Should i not wish to spicify a range like B8:B33 but have the code just work for B8 & down the page using the ("B8" & Rows.Count).End(xlUp)
how would this be written.
Click to expand...
.
.
If you KNOW that the code can ONLY run against the active sheet (eg if code is placed in that Sheet's code window)
Rich (BB code): 
For Each cel In Range("B8", Range("B" & Rows.Count).End(xlUp))

Otherwise it is better practice to qualify with a sheet reference
Rich (BB code): 
Dim ws As Worksheet
Set ws = Sheets("Sheet10")
For Each cel In ws.Range("B8", ws.Range("B" & ws.Rows.Count).End(xlUp))
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
add another condition to an event change ?
2
Replies
11
Views
75
Joe4
Joe4
S
  • Solved
Use change event to change the format of a date
Replies
2
Views
157
still learning
S
Noid67
  • Question
Multiple worksheet change and Formula use
2
Replies
17
Views
347
mumps
mumps
B
  • Solved
Worksheet Change - multiple Loops in one sub
2
Replies
15
Views
256
mumps
mumps
F
  • Solved
VBA change event applied to one or multiple cells
Replies
3
Views
59
FryGirl
F

Forum statistics

Threads
1,215,059
Messages
6,122,918
Members
449,093
Latest member
dbomb1414

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top