VBA run time error

[j4ymf]

Hello all

I'm creating a holiday book for work,

In the VBA I've I have a work sheet change function that's adds a comment and changes the font to uppercase to every cell that is edited, that works fine.

But when press delete on a couple of cells while im still playing I get a

runtime error '13' Type Mismatch

Question 1 is there any way I can stop the VBA from crashing?
Question 2 is can I press a F key or something to reset the vba because im having to keep logging out and back in every time

many thanks Jason

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    'changes the cells to UPPERCASE
    If Intersect(Target, Range("A1:AH100")) Is Nothing Then Exit Sub
     
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
    
 'Adds a comment box to each cell when somthing is added to the cell

If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
If Not Target.Comment Is Nothing Then Target.Comment.Delete
Target.AddComment Text:=Application.UserName & vbNewLine & Date & vbNewLine & Time
Target.Comment.Shape.TextFrame.Characters(1, Len(Application.UserName)).Font.Bold = True

     
End Sub

 

[tygrrboi]

I can recreate your error by doing something like selecting a bunch of cells in column A and clicking Clear Contents...

To avoid that put the check first before you alter the cells...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
[COLOR=#ff0000]    If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub[/COLOR]
    If Intersect(Target, Range("A1:AH100")) Is Nothing Then Exit Sub
    
'changes the cells to UPPERCASE
    
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
    
 'Adds a comment box to each cell when something is added to the cell




    If Not Target.Comment Is Nothing Then Target.Comment.Delete
    Target.AddComment Text:=Application.UserName & vbNewLine & Date & vbNewLine & Time
    Target.Comment.Shape.TextFrame.Characters(1, Len(Application.UserName)).Font.Bold = True


     
End Sub

Although I do not know why you are checking if it is empty... Wouldn't you want a record of anyone deleting cell contents?
Personally, I would remove the Or IsEmpty(Target) part... but then again I do not know your specific situation...

 

[j4ymf]

Thank you for your reply

im willing to try anything could you please show me what you mean about the empty removed

 

[tygrrboi]

Sorry. Its not technical jargon. I thought I was being clear... Sorry for the confusion.

here it is with that part removed.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
[COLOR=#ff0000]    If Target.Cells.Count > 1 Then Exit Sub[/COLOR]
    If Intersect(Target, Range("A1:AH100")) Is Nothing Then Exit Sub
    
'changes the cells to UPPERCASE
    
    Application.EnableEvents = False
    Target = UCase(Target)
    Application.EnableEvents = True
    
 'Adds a comment box to each cell when something is added to the cell




    If Not Target.Comment Is Nothing Then Target.Comment.Delete
    Target.AddComment Text:=Application.UserName & vbNewLine & Date & vbNewLine & Time
    Target.Comment.Shape.TextFrame.Characters(1, Len(Application.UserName)).Font.Bold = True


     
End Sub

 

[j4ymf]

Hello I really like the sound of the record keeping

how do I create a log for entry and deleting?

Please help

 

[j4ymf]

Hi you are being clear its just i'm still a newbie

 

[j4ymf]

thank you tygrrboi that's works great, I don't get the error now

 

[tygrrboi]

Just playing around a little I came up with this...

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    
    If Target.Cells.Count > 1 Then Exit Sub
    If Intersect(Target, Range("A1:AH100")) Is Nothing Then Exit Sub
    
'changes the cells to UPPERCASE


    Dim PreviousEntry As String
    Dim NewEntry As String
    
    Application.EnableEvents = False
    NewEntry = UCase(Target)
    Application.Undo
    PreviousEntry = UCase(Target)
    Target = NewEntry
    Application.EnableEvents = True
    
 'Adds a comment box to each cell when something is added to the cell


    If PreviousEntry = vbNullString Then PreviousEntry = "-blank-"
    If NewEntry = vbNullString Then NewEntry = "-blank-"




    If Target.Comment Is Nothing Then
        Target.AddComment Text:=Application.UserName & " input " & NewEntry & vbNewLine & Date & vbNewLine & Time & vbNewLine
        Target.Comment.Shape.Height = [COLOR=#0000ff]45[/COLOR]
        Target.Comment.Shape.Width =[COLOR=#ff8c00] 110[/COLOR]
[COLOR=#008000]        Target.Comment.Visible = False[/COLOR]
    Else
        With Target.Comment
            .Text PreviousEntry & " was changed to " & NewEntry & vbNewLine & "by: " & Application.UserName & _
                    vbNewLine & Date & vbNewLine & Time & vbNewLine, 1, False
            .Shape.Height = .Shape.Height [COLOR=#ff0000]+ 50[/COLOR]
        End With
    End If



End Sub

If you find that words are getting cut off you can play with the height and width to start...
Also if you think its not extending the size of the comment box enough when you add a new entry, you can increase (or decrease) the height adjustment.

Finally.. I like to have my comments Hidden until you mouse-over them... then they pop up. If you want them to remain there the whole time, delete the part that says
Target.Comment.Visible = False

 

[j4ymf]

thank you for your help that's fantastic