Delete entries instead of change

[BlokeMan]

Hi,

I'm new to this forum and just learning vba. In this macro when case 14 to 16 already contains data instead of asking for change it should ask to delete the data and then you have to enter another data. In this current setup when you delete the data you dont have to enter anything in the box, other users enters 0 and it affects other cells so its better to delete it first then enter another one if they need to change. This macro is assign to a button.

Here is the macro:
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Row = ActiveCell.Row
Col = ActiveCell.Column

Select Case Col ' Select Case loop when Col
Case 2 To 11 ' Select this case if Col = 2 to 11

Select Case Row
Case 4 To 7, 9 To 13

If IsEmpty(ActiveCell) = False Then ' Test case - if cell value is not = 0 then
Response = MsgBox("The Cell already contains data. Are you sure you want to change it?", vbYesNo, "Change Confirmation") ' open message box
If Response = vbNo Then ' Check button response from msgbox
Exit Sub ' If Response is no then exit the sub process
End If
End If
Call InputInteger ' If case is true, call InputInteger Sub routine
Case Else
Response = MsgBox("Sorry. You cannot change this cell.", vbOKOnly)
Exit Sub ' Else exit sub - Row value not valid
End Select

Case 14 To 16 ' Select this case if col = 14 To 16
Select Case Row
Case 5 To 6, 8 To 17 ' Case 14 To 16 only occurs when Row is the following

If IsEmpty(ActiveCell) = False Then ' Test case - if cell value is not = 0 then
Response = MsgBox("The Cell already contains data. Are you sure you want to change it?", vbYesNo, "Change Confirmation")
If Response = vbNo Then ' Check Button response from message box
Exit Sub ' If Response is no then exit the sub routine
End If
End If
Call InputString ' If case is true, call InputString Sub routine
Case Else
Response = MsgBox("Sorry. You cannot change this cell.", vbOKOnly)
Exit Sub ' Else exit sub - Row value not valid
End Select

Case 20 ' Select if Col = 20
Select Case Row ' Case Col occurs when Row is specific conditions
Case 5 To 9, 11 To 14, 17 To 18

If IsEmpty(ActiveCell) = False Then ' Test case - If cell value isn't empty then
Response = MsgBox("The Cell already contains time/date. Are you sure you want to change it?", vbYesNo, "Change Confirmation")
If Response = vbNo Then ' Check button response from message box
Exit Sub ' If Response is no then exit sub routine
End If
End If
Call InputString1 ' If case is true call subroutine InputString
Case Else
Response = MsgBox("Sorry. You cannot change this cell.", vbOKOnly)
Exit Sub ' Else exit sub - Row value not valid
End Select
Case Else
Response = MsgBox("Sorry. You cannot change this cell.", vbOKOnly)
Exit Sub ' Else exit sub - Col value not valid

End Select

Application.ScreenUpdating = True
Application.DisplayAlerts = True

ActiveWorkbook.Save ' Saves spreadsheet after each data entry

End Sub
Sub InputInteger()

CellInp1 = Application.InputBox("Please enter the cell value:", "Enter Cell Value", , , , , , 1)
If CellInp1 = "False" Then
Exit Sub
Else
CellVal = CInt(CellInp1)
ActiveSheet.Unprotect Password:="Recon" 'Unprotect Sheet
ActiveCell.Select 'Select Active Cell
Selection.Locked = False 'Unprotect Cell
ActiveCell.Value = CellVal 'Input Cell Value from msgbox
Selection.Locked = True 'Lock Cell
ActiveSheet.Protect Password:="Recon" 'Protect Sheet
End If
End Sub
Sub InputString()

CellInp2 = Application.InputBox("Please enter Shipper Label No.:", "Enter Shipper Label No.", , , , , , 2)
If CellInp2 = "False" Then
Exit Sub
Else
ActiveSheet.Unprotect Password:="Recon" 'Unprotect Sheet
ActiveCell.Select 'Select Active Cell
Selection.Locked = False 'Unprotect Cell
ActiveCell.Value = CellInp2 'Input Cell Value from msgbox
Selection.Locked = True 'Lock Cell
ActiveSheet.Protect Password:="Recon" 'Protect Sheet
End If
End Sub
Sub InputString1()

CellInp2 = Application.InputBox("Please enter Date/Time:", "Enter Date/Time", , , , , , 2)
If CellInp2 = "False" Then
Exit Sub
Else
ActiveSheet.Unprotect Password:="Recon"
ActiveCell.Select
Selection.Locked = False
ActiveCell.Value = CellInp2
Selection.Locked = True
ActiveSheet.Protect Password:="Recon"
End If
End Sub

Thanks

 

[AlphaFrog]

Hi and welcome.

If the user leaves the InputBox blank, you don't want to delete the existing entry? Is that what you want?

If yes, try something like this...

Sub InputString()

    CellInp2 = Application.InputBox("Please enter Shipper Label No.:", "Enter Shipper Label No.", , , , , , 2)
    If CellInp2 = "False" [COLOR="Red"]Or CellInp2 = ""[/COLOR] Then
        Exit Sub
    Else
        ActiveSheet.Unprotect Password:="Recon"     'Unprotect Sheet
[COLOR="Green"]'        ActiveCell.Select                           'Select Active Cell   [/COLOR]'Not needed
[COLOR="Green"]'        Selection.Locked = False                    'Unprotect Cell  [/COLOR]'Not needed
        ActiveCell.Value = CellInp2                 [COLOR="Green"]'Input Cell Value from msgbox[/COLOR]
[COLOR="Green"]'        Selection.Locked = True                     'Lock Cell  [/COLOR]'Not needed
        ActiveSheet.Protect Password:="Recon"       [COLOR="Green"]'Protect Sheet[/COLOR]
    End If
    
End Sub

 

[BlokeMan]

Thanks for the quick reply AlphaFrog,
If the user wants to change the existing entry they should delete it first then enter another one, this is to avoid any entry in that cell if they want to delete it.

Thanks again

Hi and welcome.

If the user leaves the InputBox blank, you don't want to delete the existing entry? Is that what you want?

If yes, try something like this...

Sub InputString()

    CellInp2 = Application.InputBox("Please enter Shipper Label No.:", "Enter Shipper Label No.", , , , , , 2)
    If CellInp2 = "False" [COLOR=Red]Or CellInp2 = ""[/COLOR] Then
        Exit Sub
    Else
        ActiveSheet.Unprotect Password:="Recon"     'Unprotect Sheet
[COLOR=Green]'        ActiveCell.Select                           'Select Active Cell   [/COLOR]'Not needed
[COLOR=Green]'        Selection.Locked = False                    'Unprotect Cell  [/COLOR]'Not needed
        ActiveCell.Value = CellInp2                 [COLOR=Green]'Input Cell Value from msgbox[/COLOR]
[COLOR=Green]'        Selection.Locked = True                     'Lock Cell  [/COLOR]'Not needed
        ActiveSheet.Protect Password:="Recon"       [COLOR=Green]'Protect Sheet[/COLOR]
    End If
    
End Sub

 

[AlphaFrog]

So for case 14 to 16, if the actvecell is filled, delete it and exit (no inputbox). If the activecell is empty, show inputbox for new entry?

 

[BlokeMan]

Yes

So for case 14 to 16, if the actvecell is filled, delete it and exit (no inputbox). If the activecell is empty, show inputbox for new entry?

 

[AlphaFrog]

        Case 14 To 16    ' Select this case if col = 14 To 16
            Select Case Row
                Case 5 To 6, 8 To 17    ' Case 14 To 16 only occurs when Row is the following
                    
                    If IsEmpty(ActiveCell) = False Then    ' Test case - if cell value is not = 0 then
                        Response = MsgBox("The Cell already contains data. Are you sure you want to delete it?", vbYesNo, "Change Confirmation")
                        If Response = vbYes Then    ' Check Button response from message box
                            ActiveSheet.Unprotect Password:="Recon"     'Unprotect Sheet
                            ActiveCell.ClearContents                    'Clear active cell
                            ActiveSheet.Protect Password:="Recon"       'Protect Sheet
                        End If
                    Else
                        Call InputString    ' If case is true, call InputString Sub routine
                    End If
                Case Else
                    Response = MsgBox("Sorry. You cannot change this cell.", vbOKOnly)
                    Exit Sub    ' Else exit sub - Row value not valid
                End Select

 

[BlokeMan]

Thank you very much AlphaFrog this solve my problem. Have a nice day