Edit code from specific cell to a range of cells, run time erro type mismatch

ipbr21054

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

I currently have the working code supplied below in use,

This is how it works.
I complete each cell with values in row 7 & i see cell B7 10th character change to red & also the value in cell E7 show in red.
The red part of the code is applied from values entered into the cell B7 BUT i have had a user lean on the keyboard & delete the value from say cell B25 He thought by typing the value back into the cell B25 would work but obviously this then doesnt allow the 10th character to change to red.
The only way at present is to re-enter the customer into row B7

I still need to insert a new row & start entering values in row 7 BUT can we also have a safety net where should leaning on the keyboard happen again the value can just be entered into that cell & for the 10th character turn red.

The text shown in red below was changed from just a specific cell to a range of cells but that just gave me a run time error type mismatch.


Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim myStartCol As String
    Dim myEndCol As String
    Dim myStartRow As Long
    Dim myLastRow As Long
    Dim myRange As Range


    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.ScreenUpdating = False
    
'   *** Specify columns to apply this to ***
    myStartCol = "A"
    myEndCol = "J"


'   *** Specify start row ***
    myStartRow = 7
    
'   Use first column to find the last row
    myLastRow = Cells(Rows.Count, myStartCol).End(xlUp).Row
    
'   Build range to apply this to
    Set myRange = Range(Cells(myStartRow, myStartCol), Cells(myLastRow, myEndCol))
    
'   Clear the color of all the cells in range
    myRange.Interior.ColorIndex = 6
    
'   Check to see if cell selected is outside of range
    If Intersect(Target, myRange) Is Nothing Then Exit Sub
    
'   Highlight the row and column that contain the active cell
    Range(Cells(Target.Row, myStartCol), Cells(Target.Row, myEndCol)).Interior.ColorIndex = 8
    Target.Interior.Color = vbGreen


    Application.EnableEvents = False
    Select Case Mid(Range[COLOR=#ff0000]("B7")[/COLOR].Value, 10, 1)
    Case Is = "S"
            Range("E7").Value = "1995"
    Case Is = "T"
            Range("E7").Value = "1996"
    Case Is = "V"
            Range("E7").Value = "1997"
    Case Is = "W"
            Range("E7").Value = "1998"
    Case Is = "X"
            Range("E7").Value = "1999"
    Case Is = "Y"
            Range("E7").Value = "2000"
    Case Is = "1"
            Range("E7").Value = "2001"
    Case Is = "2"
            Range("E7").Value = "2002"
    Case Is = "3"
            Range("E7").Value = "2003"
    Case Is = "4"
            Range("E7").Value = "2004"
    Case Is = "5"
            Range("E7").Value = "2005"
    Case Is = "6"
            Range("E7").Value = "2006"
    Case Is = "7"
            Range("E7").Value = "2007"
    Case Is = "8"
            Range("E7").Value = "2008"
    Case Is = "9"
            Range("E7").Value = "2009"
    Case Is = "A"
            Range("E7").Value = "2010"
    Case Is = "B"
            Range("E7").Value = "2011"
    Case Is = "C"
            Range("E7").Value = "2012"
    Case Is = "D"
            Range("E7").Value = "2013"
    Case Is = "E"
            Range("E7").Value = "2014"
    Case Is = "F"
            Range("E7").Value = "2015"
    Case Is = "G"
            Range("E7").Value = "2016"
    Case Is = "H"
            Range("E7").Value = "2017"
    Case Is = "J"
            Range("E7").Value = "2018"
    Case Is = "K"
            Range("E7").Value = "2019"
    End Select
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Range[COLOR=#ff0000]("E7")[/COLOR].Font.Color = vbRed
End Sub

You might need this code also.

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 < 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("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
    Range("B7").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
End Sub
 
Last edited:

Excel Facts

When did Power Query debut in Excel?
Although it was an add-in in Excel 2010 & Excel 2013, Power Query became a part of Excel in 2016, in Data, Get & Transform Data.

Forum statistics

Threads
1,223,894
Messages
6,175,254
Members
452,623
Latest member
Techenthusiast

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