Private Sub CheckData_Click()
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Date : 09/02/2004
'Author : Bruce ******* ****
'Purpose : Checks values entered are valid Lookup values, depths are sequential and percentages are between 0 and 100
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
'Updates:
'----------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Dim Session As Object
Dim db As Object
Dim doc As Object
Dim view As Object
Dim documentString As String
Set Session = CreateObject("Notes.NotesSession")
Set db = Session.CurrentDatabase
Set view = db.GetView("Lookup")
Set doc = view.GetFirstDocument
Set doc = view.GetDocumentByKey(Lookup1)
Dim CheckColumn As Integer
Dim c As Integer
Dim CorrectValueFound As Boolean
'Check all Lithology codes entered
Call CheckLookup(Lookup1, "StrRetVal", "StrDispVal", 5, 205, 3, 2)
'Check all Lithology names entered
Call CheckLookup(Lookup1, "StrDispVal", "StrRetVal", 5, 205, 2, 3)
'Check all Colour Names entered
Call CheckLookup(Lookup2, "StrDispVal", "StrRetVal", 5, 205, 5, 0)
'Check all Depths entered follow the rule : X2 > X1
CheckColumn = 1
For c = 6 To 205
ValueOK = 0
If Sheet1.Cells(c, CheckColumn) = "" And ValueOK = 0 Then
ValueOK = 1
End If
If IsNumeric(Sheet1.Cells(c, CheckColumn)) And IsNumeric(Sheet1.Cells(c - 1, CheckColumn)) Then
If CInt(Sheet1.Cells(c, CheckColumn)) > CInt(Sheet1.Cells(c - 1, CheckColumn)) Then
ValueOK = 1
End If
ElseIf Sheet1.Cells(c, CheckColumn) <> "" Then
ValueOK = 0
End If
If ValueOK = 0 Then
Call IncorrectValue("An incorrect value has been entered, Depth must be greater than " + CStr(Sheet1.Cells(c - 1, CheckColumn)) + ", please re-enter", c, CheckColumn)
Exit Sub
End If
Next
'Check all percentages are between 0 and 100
'Column for percentage hardcoded to 4
CheckColumn = 4
For c = 5 To 205
ValueOK = 0
If Sheet1.Cells(c, CheckColumn) = "" And ValueOK = 0 Then
ValueOK = 1
End If
If IsNumeric(Sheet1.Cells(c, CheckColumn)) Then
If CInt(Sheet1.Cells(c, CheckColumn)) >= 0 Or CInt(Sheet1.Cells(c, CheckColumn)) <= 100 Then
ValueOK = 1
End If
ElseIf Sheet1.Cells(c, CheckColumn) <> "" Then
ValueOK = 0
End If
If ValueOK = 0 Then
Call IncorrectValue("An incorrect value has been entered, Percentage must be between 0 and 100, please re-enter", c, CheckColumn)
Exit Sub
End If
Next
'Check that all first 3 columns have been filled for all rows of data where any of the columns has a value
For c = 5 To 205
Set ws = Application.ActiveSheet
WithData = 0
FirstColumn = 1
LastColumn = 8 'Number of columns to check
For Each v In ws.Range(Cells(c, FirstColumn), Cells(c, LastColumn))
'Check all mandatory fields for this row have been completed
If v.Value <> "" Then
WithData = WithData + 1
End If
Next v
If WithData < LastColumn And WithData <> 0 Then
If (ws.Cells(c, FirstColumn).Value = "" And ws.Cells(c, 2).Value = "") Or ((ws.Cells(c, FirstColumn).Value = "" Or ws.Cells(c, 2).Value = "") And WithData > 1) Then
MsgBox "Please enter a value for Depths in Row " + CStr(c), vbOKOnly, "Fill in Mandatory cell value"
Application.Goto Cells(c, FirstColumn)
Cancel = True
Exit Sub
End If
End If
Next
'Check filled in values that should be numeric are numeric
For c = 5 To 205
Set ws = Application.ActiveSheet
WithData = 0
FirstColumn = 1
LastColumn = 2 'Number of columns to check
For Each v In ws.Range(Cells(c, FirstColumn), Cells(c, LastColumn))
'Check all mandatory fields for this row have been completed
If v.Value <> "" Then
If Not (IsNumeric(v.Value)) Then
MsgBox "You must enter NUMERIC values for Depths in Row " + CStr(c), vbOKOnly, "Fill in Mandatory cell value"
Application.Goto Cells(c, FirstColumn)
Cancel = True
Exit Sub
End If
End If
Next v
Next
End Sub
