Importing data with formating issues using change event

[jdub34]

Good Morning all, I am looking to write a macro that I can import data from another worksheet that has issues such as font style, size, number format into a master sheet that will have set formating. I want cut and paste features to be set to what i want the worksheet to look like.

I have co-workers who do not understand or do not care on how to properly cut and paste into a shared worksheet. I am very picky on how a sheet should work and I don't want to spend time going over other peoples entries.

I am posting my code which works but I feel that it could be more efficient. When I cut and paste excel cells start to blink and a every once and while stops working, but then the formatting is how i like it.

I hope to find better solution

Private Sub Worksheet_Change(ByVal Target As Range)
    On Error GoTo ErrHandler:
    Dim cell As Range
    Dim myVal As String
    Dim myNum As Integer
    Dim changed As Range, c As Range
    Dim cVal

Set Target = Intersect(Target, Target.Parent.UsedRange)
    If Not Target Is Nothing Then
        For Each cell In Target
            cell.Font.Name = "Book Antiqua"
            cell.Font.Size = 10
            myVal = "#,##0.00_);(#,##0.00)"
            myVal = myVal & myNum
        Next cell

    Const myR As String = "A3:M20000,O3:BK20000" '<- My range(s)
  
    Set changed = Intersect(Target, Range(myR))
    If Not changed Is Nothing Then
        Application.EnableEvents = False
        For Each c In changed
            cVal = c.Value
            Select Case True
                Case IsEmpty(cVal), IsNumeric(cVal), _
                        IsDate(cVal), IsError(cVal)
                    ' Do nothing
                Case Else
                    c.Value = UCase(cVal)
                    c.Font.Size = 10
                    c.Font.Name = "Book Antiqua"
            End Select
        Next c
        Application.EnableEvents = True
    End If
End If
ErrHandler:
End Sub

 

[vletm]

PrivateSub Worksheet_Change(ByVal Target As Range)
'add next row
Application.ScreenUpdating=False
OnErrorGoTo ErrHandler:
' - Your the rest of code -
'add next row
Application.ScreenUpdating=True
ErrHandler:
End Sub

 

[jdub34]

I just want to thank you vletm for your insight for the modification of my code.