Worksheet change event for data validation??

[Guest]

I've got a worksheet with about 70 columns and have created 6 different
custom views. I now need to protect certain columns (ideally this would be
different columns for each view) but the views dont work once I've protected
the sheet. Is there a way around this?

Can I apply data validation to the cells/columns to prevent any changes
being made to certain coloumns? How could I use worksheet change event to set
data validation? Any code greatly appreciated!

Thanks

 

[Bob Phillips]

Why not just Worksheet_Selection event to stop them visiting columns


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Const WS_RANGE = "B:B,H:H,M:M"

If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Range("A1").Select
End If

End Sub

This is worksheet event code, which means that it needs to be
placed in the appropriate worksheet code module, not a standard
code module. To do this, right-click on the sheet tab, select
the View Code option from the menu, and paste the code in.
--

HTH

Bob Phillips

(replace xxxx in the email address with gmail if mailing direct)

 

[Guest]

Thanks - I like it.
What would I have to do to change the code to stop the cursor returning to
A1? Could we make it so the cursor jumps back to the last 'selectable'
column??

 

[Guest]

Data validation would be set manually before releasing your sheet. It is
unclear how the validation would need to be set dynamically in a change
event.

Possibly You can use code to
Unprotect the sheet
change the view
Reprotect the sheet.

 

[Guest]

Just a thought.
If the user disables macros, of course you scheme won't work.

If your protection isn't important, then I guess that isn't a consideration.

 

[Guest]

Thanks for the input Bob and Tom,

I've had to issue my spreadheets to the users now to meet a deadline but am
planning on writing some audit codes to validate the data once the
spreadsheets are returned to me.

I've found this code as a start.... any better/simpler ideas are welcome!
I will need to check formulas haven't had values pasted over them.
Also make sure comments column has been filled in if margin diff is over 10%.


Sub AuditSheet()
' Carry out an Audit of all active rows in a spreadsheet.

Dim nRows As Long
Dim RN As Long
Dim nCols As Long
Dim EMsg As String

'On Error GoTo errHandler

With ActiveWorkbook.ActiveSheet
With .Cells(.Rows.Count, 1)
nRows = .End(xlUp).Row
End With
End With

For RN = 2 To nRows 'check each row in turn (assume row 1 is
header)
EMsg = ChkCol1(RN)
If EMsg <> "" Then
Call ProcessError(EMsg, RN, 1)
End If
EMsg = ChkCol2(RN)
If EMsg <> "" Then
Call ProcessError(EMsg, RN, 2)
End If
EMsg = ChkCol3(RN)
If EMsg <> "" Then
Call ProcessError(EMsg, RN, 3)
End If
Next RN

errHandler:
If Err.Number <> 0 Then
MsgBox (vbCrLf & "An Error Ocurred. Error Number: " & Err.Number & "
" & Err.Description & vbCrLf)
Else
MsgBox ("Checking Complete")
End If
End Sub

Private Sub ProcessError(ErrMsg As String, rrr As Long, ccc As Long)
Dim ret As Integer
Dim ErrTitle As String

Cells(rrr, ccc).Activate


ErrTitle = " Error Found In Cell - " & ActiveCell.Address & " "


ErrMsg = ErrMsg & vbCrLf & vbCrLf & "Continue Checking?"
ret = MsgBox(ErrMsg, vbYesNo, ErrTitle)
If ret <> vbYes Then
End
End If
End Sub


Private Function ChkCol1(RowNum As Long) As String
Dim ErrMsg As String
ErrMsg = ""

If Cells(RowNum, 1).HasFormula = True Then
ErrMsg = ErrMsg & "Cell contains a formula." & vbCrLf
End If

If IsNumeric(Cells(RowNum, 1).Value) <> True Then
ErrMsg = ErrMsg & "Cell must contain a number." & vbCrLf
ElseIf Cells(RowNum, 1).Value > 10 Or Cells(RowNum, 1).Value < -10 Then
ErrMsg = ErrMsg & "Cell value should be between -10 and 10." & vbCrLf
End If
' Other tests include Isempty, IsLogical, IsDate, IsText

ChkCol1 = ErrMsg
End Function

Private Function ChkCol2(RowNum As Long) As String
Dim ErrMsg As String
ErrMsg = ""

If Cells(RowNum, 2).HasFormula = True Then
ErrMsg = ErrMsg & "Cell contains a formula." & vbCrLf
End If

If IsDate(Cells(RowNum, 2).Value) <> True Then
ErrMsg = ErrMsg & "Cell must contain a date." & vbCrLf
End If
ChkCol2 = ErrMsg
End Function


Private Function ChkCol3(RowNum As Long) As String
Dim ErrMsg As String
ErrMsg = ""

If Cells(RowNum, 1).Value < 5 Then
If IsEmpty(Cells(RowNum, 3).Value) = True Then
ErrMsg = ErrMsg & "If Column A is less than 5, Column C must
explain why." & vbCrLf
End If
End If
ChkCol3 = ErrMsg
End Function