Any way to reduce/combine in this code?
 

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo addError
If Not (Application.Intersect(Target, Range("E7:H10000")) Is Nothing) Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
If Not (Application.Intersect(Target, Range("I7:J10000")) Is Nothing) Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
Exit Sub
addError:
Select Case Err
Case 13:
Exit Sub
Case Else:
Open ThisWorkbook.Path & "\ErrorLog.log" For Append As #2 'Open file
Print #2, Application.Text(Now(), "mm/dd/yyyy HH:mm") _
; Error(Err); Err 'Write data
Close #2 'Close

MsgBox "An error has occurred, contact John Doe (extension 123)"
End Select
End Sub

Any way to reduce/combine in this code?
 

Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo addError
If Not (Application.Intersect(Target, Range("E7:J10000")) Is Nothing)
Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
Exit Sub
addError:
Select Case Err
Case 13:
Exit Sub
Case Else:
Open ThisWorkbook.Path & "\ErrorLog.log" For Append As #2 'Open file
Print #2, Application.Text(Now(), "mm/dd/yyyy HH:mm") _
; Error(Err); Err 'Write data
Close #2 'Close

MsgBox "An error has occurred, contact John Doe (extension 123)"
End Select
End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)



"ADK" wrote in message
...
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo addError
If Not (Application.Intersect(Target, Range("E7:H10000")) Is Nothing) Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
If Not (Application.Intersect(Target, Range("I7:J10000")) Is Nothing) Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
Exit Sub
addError:
Select Case Err
Case 13:
Exit Sub
Case Else:
Open ThisWorkbook.Path & "\ErrorLog.log" For Append As #2 'Open file
Print #2, Application.Text(Now(), "mm/dd/yyyy HH:mm") _
; Error(Err); Err 'Write data
Close #2 'Close

MsgBox "An error has occurred, contact John Doe (extension 123)"
End Select
End Sub

Any way to reduce/combine in this code?
 

How about this? Not sure if it matters on time, having it only go as far as
the last row with values


Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo addError
Dim LastRow As String
LastRow = Range("V10000").End(xlUp).Row
LastRow = "E7:J" & LastRow
If Not (Application.Intersect(Target, Range(LastRow)) Is Nothing) Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
Exit Sub
addError:
Select Case Err
Case 13:
Exit Sub
Case Else:
Open ThisWorkbook.Path & "\ErrorLog.log" For Append As #2 'Open file
Print #2, Application.Text(Now(), "mm/dd/yyyy HH:mm") _
; Error(Err); Err 'Write data
Close #2 'Close

MsgBox "An error has occurred, contact Jeffrey Tocha (extension 359)"
End Select
End Sub



"Bob Phillips" wrote in message
...
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo addError
If Not (Application.Intersect(Target, Range("E7:J10000")) Is Nothing)
Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
Exit Sub
addError:
Select Case Err
Case 13:
Exit Sub
Case Else:
Open ThisWorkbook.Path & "\ErrorLog.log" For Append As #2 'Open file
Print #2, Application.Text(Now(), "mm/dd/yyyy HH:mm") _
; Error(Err); Err 'Write data
Close #2 'Close

MsgBox "An error has occurred, contact John Doe (extension 123)"
End Select
End Sub

--
---
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my
addy)



"ADK" wrote in message
...
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo addError
If Not (Application.Intersect(Target, Range("E7:H10000")) Is Nothing)
Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
If Not (Application.Intersect(Target, Range("I7:J10000")) Is Nothing)
Then
With Target
If Not .HasFormula Then
.Value = UCase(.Value)
End If
End With
End If
Exit Sub
addError:
Select Case Err
Case 13:
Exit Sub
Case Else:
Open ThisWorkbook.Path & "\ErrorLog.log" For Append As #2 'Open
file
Print #2, Application.Text(Now(), "mm/dd/yyyy HH:mm") _
; Error(Err); Err 'Write data
Close #2 'Close

MsgBox "An error has occurred, contact John Doe (extension 123)"
End Select
End Sub