VBA code needed to repopulate a cell if it's deleted and show a message box.

Associate
Joined
23 Apr 2007
Posts
1,785
Location
Cardiff-ish, Wales
Hi guys,

I've got some code that populates a table with data from another table whenever a date is selected from a dropdown list (in cell B9).

I'm trying to add some more functionality so that if someone deletes a cell in the first table, then it will repopulate it and throw a message box saying "Oi!, Stop it!" ... or something a bit more diplomatic :D I can't simply protect and lock the cells as I need to be able to click on a cell to get some other information and RAG status using active cell formula. The second table, which contains all the important formula is protected though.

The sample code shows it working for a single cell, but I need to extend this to a range and it keeps falling over. Any ideas greatly appreciated.

Cheers,

Jed.

Code:
Private Sub Worksheet_Change(ByVal Target As Range)

If Target = Range("$b$9") Then
    
Application.EnableEvents = False
    
   Call PopulateSummaryTable
    
Application.EnableEvents = True
    
End If


'If Range("e6") = "" Then

 '       Sheet27.Range("e6").Value = Sheet27.Range("e64").Value
  '      MsgBox "Please don't delete cell values."
'End If


End Sub



PolulateSummaryTable:

Code:
Sub PopulateSummaryTable()

Sheet27.Range("e6:Q20").Value = Sheet27.Range("e64:Q78").Value

End Sub
 
Yes. However, check my second paragraph:

"I can't simply protect and lock the cells as I need to be able to click on a cell to get some other information and RAG status using active cell formula. The second table, which contains all the important formula is protected though."

:D
 
I managed to get it working with this, using a similar Not Intersect function:

Code:
Sub DataDelete()

If Not Intersect(Range("A:CV"), Target) Is Nothing Then


Private Sub Worksheet_Change(ByVal Target As Range)


If Target = Range("$b$9") Then
    
Application.EnableEvents = False
    
   Call PopulateSummaryTable
    
Application.EnableEvents = True
    
End If


If Not Intersect(Range("E6:Q20"), Target) Is Nothing Then
    If Target.Value = "" Then
        Target.Value = Target.Offset(58, 0).Value
        MsgBox "Please don't delete cell values. Change data through Data Entry only", vbExclamation
    End If
End If


End Sub

Thanks for the help guys :)
 
Back
Top Bottom