ipbr21054
Well-known Member
- Joined
- Nov 16, 2010
- Messages
- 5,738
- Office Version
- 2007
- Platform
- Windows
Hi,
The code in use is shown below
I have added the code in red to the existing change event code but nothing happens in respect of the small case changing to upper case & i also dont receive an error message ?
I am trying to target cell range F2:G2 so when either cell has been left the Ucase will be applied
The code in use is shown below
I have added the code in red to the existing change event code but nothing happens in respect of the small case changing to upper case & i also dont receive an error message ?
I am trying to target cell range F2:G2 so when either cell has been left the Ucase will be applied
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
With ThisWorkbook.Sheets("HONDA SHEET")
If Not Intersect(Target, .Range("A13")) Is Nothing And .Range("A13") <> "" Then
If Len(.Range("A13").Value) <> 17 And Len(.Range("A13").Value) <> 11 Then
.Range("A13").Interior.ColorIndex = 3
MsgBox "Honda Japan Use 11 Character Vin Numbers." & vbNewLine & "" & vbNewLine & "Honda Europe Use 17 Character Vin Numbers." & vbNewLine & "" & vbNewLine & "Please Check & Try Again", vbCritical, "Chassis Number Wrong Character Count"
.Range("A13").ClearContents
.Range("A13").Interior.ColorIndex = 2
.Range("A13").Activate
Else
Application.EnableEvents = False
.Rows(21).Insert Shift:=xlDown
.Range("A21:G21").Borders.Weight = xlThin
.Range("G21").Value = Date
.Range("A21").Value = UCase(.Range("A13").Value)
.Range("B21").Select
.Range("A13").ClearContents
.Range("A21").Characters(Start:=10, Length:=1).Font.ColorIndex = 3
Application.EnableEvents = True
End If
[COLOR=rgb(184, 49, 47)] If Target.Address = ("F2:G2") Then
Application.EnableEvents = False
Target.Value = UCase(Target.Value)
Application.EnableEvents = True
End If[/COLOR]
End If
End With
Target.Interior.ColorIndex = 6 ' *** THIS IS CELL A13 ***
If Not Intersect(Target, Range("F21")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
End If
If Target.Address = "$F$21" Then
Call sheettolist
End If
Application.EnableEvents = True
If Not Intersect(Target, Range("Z21")) Is Nothing Then
Application.EnableEvents = False
Range("Z21").Value = UCase(Range("Z21").Value)
Application.EnableEvents = True
End If
If Not Intersect(Target, Range("C21")) Is Nothing Then
Application.EnableEvents = False
Range("C21").Value = UCase(Range("C21").Value)
Application.EnableEvents = True
End If
End Sub