method undo of object _application failed

[mef1sto]

Hi guys! Here's another error that bothers me lately.The code is:
If Not Intersect(Target, Range("B16:E28")) Is Nothing Then
If Len(Target.Value) = False Then 'Or IsNumeric(Target) <> True Then
Target.Value = ""
With Application
.EnableEvents = False
.Undo
.EnableEvents = True
End With
GoTo LetsContinue
Target.Value = ""
End If
End If

but it keeps showing that error twice and it actually does the undo. Can anyone tell me another way of solving this? Already tried my best, but not good enough. Thanks!

 

[mef1sto]

Great job so far, you figured it up after all. Well to answer your questions:
1. it doesn't allow any changes by the user because i have put a inputbox on a different cell and i give them values through that inputbox. I don't need a yes/no dialog for deletion, just maybe a msgbox saying it's not allowed to change values for e.g
2. Nice remark, i don't want to allow blank cells either, and no, no dialog here, just a message as well.
3. I don't want to allow multiple cells to be changed (copy/paste either)

And yes, that was the bug i've been telling you about, if i select multiple cells, the values can be deleted by multiple selection of cells.
So i need help with this and i'd appreciate anyones help! Thank you!

 

[jsotola]

try this code

i got rid of the "on error goto" command

it is always bad to use this because it tends to hide programming errors

Dim timeStamp As Double


Dim cellStampRow As Long
Dim cellStampCol As Long




Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Timer < timeStamp + 0.5 Then 'And Target.Row = cellStampRow And Target.Column = cellStampCol Then
        Exit Sub ' trap double event (less than .5 seconds apart)
    End If
    
    If ActiveSheet.ProtectContents Then Exit Sub
    
    Application.EnableEvents = False
    
    If Target.Count > 1 Then
    
        Application.Undo
        MsgBox "changing multiple cells is not allowed", vbCritical
        timeStamp = Timer
    
    End If


    If Not Intersect(Target, Range("A2:A4,A6,A15:A28,D7:D10,D12:D13,J12,B15:G15,F12,G13,H12")) Is Nothing Then
                                                                            '|'
        If Len(Trim(Target.Value)) = 0 Then     ' blank cell                '|'
            Application.Undo                    ' no delete allowed         '|'  add the range to the "if" command below
            MsgBox "delete not allowed here", vbCritical                    '|'  and delete this whole section
            timeStamp = Timer                                               '|'  if you do not want to allow any changes
        End If                                                              '|'
                                                                            '|'
    End If                                                                  '|'
                                                                            '|'
    If Not Intersect(Target, Range("B16:E28")) Is Nothing Then ' <------------'
    
        Application.Undo        ' no changes allowed here
        MsgBox "Nu puteti edita acest camp!", vbCritical
        timeStamp = Timer
    
    End If
    
    If Not Intersect(Target, Range("B1:B8")) Is Nothing Then        ' example of confirmation dialog
        Dim before As Variant                                       ' delete section for your use
        Dim after As Variant
        
        after = Target.Value        ' this is a sample area
        Application.Undo            '
        before = Target.Value       ' drag and drop does not get caught
        Application.Undo
                
        If Not vbYes = MsgBox("do you really want to change the cell ?", vbYesNo + vbCritical + vbDefaultButton2, "confirm data change") Then
            Target.Value = before
        End If
        
        timeStamp = Timer
    
    End If


    Application.EnableEvents = True


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    
    If Target.Count > 1 Then            ' prevent range selection
    
        Cells(Target.Row, Target.Column).Select
        MsgBox "selecting multiple cells is not allowed", vbCritical
    
    End If


End Sub

 

[mef1sto]

Hey! Thank you so much for the valuable tech. Part of the code works great but it still needs a little more testing. So, all in all i really appreciate your work, nice job, thank you!

 

[mef1sto]

@jsotola i've came up with this error "Method 'Undo' of object '_Application' failed" when i select cells in Range("F16:F28") because these cells have a formula (they calculate other cells). How can i bypass this range from undo?

 

[jsotola]

???


Worksheet_SelectionChange event handler prevents multiple cell selection

you should get a warning if you try to select F16:F28

there is some piece of info that you have not revealed

do you have other code running?


</pre>

 

[mef1sto]

Well i have a formula in that range that is

Dim rngF As Range
Dim rng16F As Range
Set rngF = Cells(lRow, 6)
Set rng16F = Range(Cells(16, 6), Cells(16, 6).End(xlDown).Offset(-1, 0))
rngF.Formula = "=SUM(F16:F" & lRow - 1 & ")"

and it's in a different module but it calls from Private Sub Worksheet_SelectionChange(ByVal Target As Range), just so you know..
So if i happen to select a cell from column E with a cell from column F it shows me that error and it also copies into the column E cell the formula from column F. Can you tell me why?