In my workbook i am using some code i found online to allow users to overwrite the result of a formula if needed but not overwrite the formula. the problem is that when the sheets are protected all the cells that are using this formula get a #VALUE error as soon as any change is made to the workbook. I have code that protects all sheets with UserInterfaceOnly enabled when the workbook is opened. I also tried protecting and unprotecting the sheet when the code is ran, but it didnt seem to work and it slows excel down. I have looked high and low for a solution, but cant find one. can anyone help me
In an unportected cell i am using:
=IF(CellEntry()<>"",CellEntry(),IF(SUM(A13)>0,VLOOKUP(B13,PriceList,2,FALSE),""))
In ThisWorkbook
Code
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Excel.Range)
Dim myRange As Range, oneCell As Range, xVal As Variant
On Error Resume Next
Set myRange = Target.SpecialCells(xlCellTypeAllValidation)
On Error GoTo 0
If myRange Is Nothing Then Exit Sub
For Each oneCell In myRange
With oneCell
If .HasFormula Then
Rem formula entered
If InStr(LCase(.FormulaR1C1), functionName) = 0 Then
Rem non-ce formula entered, delete ce-Validation
.Validation.Delete
Else
Rem new ce formula entered, update stored formula
xVal = CellEntry(oneCell)
End If
Else
If InStr(LCase(.Validation.ErrorMessage), functionName) = 0 Then
Rem cell has non-CE validation
Else
Rem set new value for CellEntry and replace formula in cell
.Validation.InputMessage = CStr(.Value)
Application.EnableEvents = False
.FormulaR1C1 = .Validation.ErrorMessage
Application.EnableEvents = True
End If
End If
End With
Next oneCell
End Sub
In A Module:
Code
Function CellEntry(Optional ByVal inputCell As Range) As Variant
Rem returns the text last entered in the cell
Rem validation.InputMessage holds CellEntry value: .ErrorMessage holds formula
On Error Resume Next
If inputCell Is Nothing Then Set inputCell = Application.Caller
On Error GoTo 0
If inputCell Is Nothing Then
CellEntry = vbNullString
Else
With inputCell.Range("a1").Validation
On Error Resume Next
If IsNumeric(.InputMessage) Then
CellEntry = CDbl(.InputMessage)
Else
CellEntry = .InputMessage
End If
If .Parent.Address <> Application.Caller.Address Then Exit Function
On Error GoTo 0
.Delete
.Add Type:=xlValidateCustom, AlertStyle:=xlValidAlertInformation, Formula1:="=(1=1)"
.ErrorMessage = .Parent.FormulaR1C1
.InputMessage = CellEntry
.ShowInput = False
.ShowError = False
End With
End If
End Function