DATA VALADATION

[BENSON]

The code below works great on my spread sheet ,it is designed to force users to enter data before closing or saving on certain days of the week, seven colums Tue- Mon .Could further code be added to stop users from entering data into a day colum that has not yet arrived.Ie if today is Fri do not allow any data imput in collums Sat- Mon, but allow data entry into Tue - Fri. This is to stop users from entering say Zeros in other cells to open and close worksheet without my error message showing

Thks

[VBA]
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.ScreenUpdating = False
Dim Start As Boolean
Dim Rng(8) As Range
Dim ThisDay As Long, DayIndex As Long, DayName


Dim Prompt As String, RngStr As String
Dim Cell As Range

'set your ranges here
'Rng1 is on sheet "Group Profile" and cells B5 through B14
'Cell F1, A range of F5 through F7 etc. you can change these to
'suit your needs.
Set Rng(1) = Sheets("DAILY STOCK").Range("d5:d240")
Set Rng(2) = Sheets("DAILY STOCK").Range("f5:f240")
Set Rng(3) = Sheets("DAILY STOCK").Range("h5:h240")
Set Rng(4) = Sheets("DAILY STOCK").Range("j5:j240")
Set Rng(5) = Sheets("DAILY STOCK").Range("l5:l240")
Set Rng(6) = Sheets("DAILY STOCK").Range("n5:n240")
Set Rng(7) = Sheets("DAILY STOCK").Range("p5240")
Set Rng(8) = Sheets("DAILY STOCK").Range("v5:v240")

ThisDay = Weekday(Date, vbTuesday)
If ThisDay = 7 Then ThisDay = 8
DayName = Array("Tuesday", "Wednesday", "Thursday", "Friday", "Saturday", "Sunday", "Monday", "Stock_Close")

'message is returned if there are blank cells
Prompt = "PLEASE COMPLETE TODAYS ENTRIES. " & _
"IF ANY CELLS ARE INCOMPLETE" & vbCrLf & "YOU WILL NOT BE ABLE " & _
"TO CLOSE OR SAVE THE WORBOOK " & _
" IF YOU DID NOT RECEIVE A PARTICULAR STOCK ITEM TODAY ENTER ZERO. " & vbCrLf & vbCrLf & _
"THE FOLLOWING CELLS ARE INCOMPLETE AND HAVE BEEN HIGHLIGHTED YELLOW:" _
& vbCrLf & vbCrLf
Start = True
'highlights the blank cells
For DayIndex = 1 To ThisDay
For Each Cell In Rng(DayIndex)
If Cell.Value = vbNullString Then
Cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & UCase(DayName(DayIndex - 1)) & vbCrLf
Start = False
RngStr = RngStr & Cells(Cell.Row, 1).Value & ", "
Else
Cell.Interior.ColorIndex = 0 '** no color
End If
Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 2)
Next DayIndex

If RngStr <> "" Then
MsgBox Prompt & RngStr, vbCritical, "Incomplete Data"
Cancel = True
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
End If
Application.ScreenUpdating = True
End Sub
[/VBA]

[Bob Phillips]

Looking at the code it already seems to do this. You set ThisDay to the weekday, and only look at ranges upto and including ThisDay.

The bit I don't get is tat you set ThisDay to 8 if it is a Monday. Why?

[JimmyTheHand]

Hi Bob
I can answer your question, because this thread is the newest piece of a series, which I have followed with interest. This code was developed over 2 or 3 threads now.

The bit I don't get is tat you set ThisDay to 8 if it is a Monday. Why?

Because Rng(8) is a total of some sort, that needs to be checked at the end of each week, in other words, in each Monday.

Looking at the code it already seems to do this. You set ThisDay to the weekday, and only look at ranges upto and including ThisDay.

The code checks whether or not all necessary data has been entered, and cries if not. But, unfortunately, it doesn't stop users writing in cells belongong to the wrong day. This is the functionality that Benson wants, I think.

I wonder if it could be done by writeprotecting the sheet, and with Workbook_Open event procedure unprotecting only the range belonging to the actual day. I'm not familiar with how sheet protection works, so what do you think?

Jimmy

[Bob Phillips]

Hi Bob
I can answer your question, because this thread is the newest piece of a series, which I have followed with interest. This code was developed over 2 or 3 threads now.

Because Rng(8) is a total of some sort, that needs to be checked at the end of each week, in other words, in each Monday.

OK I understand that, but as ThisDay is changed to 8 on a Monday, Rng(7) never gets checked.

But to set the protection as you suggest should be simple in the Open event, something like this

[vba]

Private Sub Workbook_Open()
Dim aryColumns()
Dim ThisDay As Long, DayIndex As Long

aryColumns = Array(4, 6, 8, 10, 12, 14, 16, 22)

ThisDay = Weekday(Date, vbTuesday)
If ThisDay = 7 Then ThisDay = 8
With Worksheets("Group Profile")
.Unprotect
.Cells.Locked = False
For DayIndex = 1 To 8
.Columns(aryColumns(DayIndex - 1)).Locked = DayIndex > ThisDay + 1
Next DayIndex
.Protect
End With

End Sub
[/vba]

but it still has the 7/8 issue.

[JimmyTheHand]

Look at this:
[vba] If ThisDay = 7 Then ThisDay = 8

For DayIndex = 1 To ThisDay
'code here
Next DayIndex [/vba]
When ThisDay = 8, the loop goes from day 1 through to day 8, which includes day 7 as well. I don't see an issue here.

[moa]

Hi Bob,
not completely sure just from reading the code but it looks like ThisDay is just the upper bound of a loop so on Monday it iterates through the loop an extra time and checks rng(1) through to rng(8) (including rng(7)).

HTH

[moa]

snap

[Bob Phillips]

Okay, I get it.

In that case, my code would change to

[vba]

Private Sub Workbook_Open()
Dim aryColumns()
Dim ThisDay As Long, DayIndex As Long

aryColumns = Array(4, 6, 8, 10, 12, 14, 16, 22)

ThisDay = Weekday(Date, vbTuesday)
With Worksheets("Group Profile")
.Unprotect
.Cells.Locked = False
For DayIndex = 1 To 7
.Columns(aryColumns(DayIndex - 1)).Locked = DayIndex > ThisDay + 1
Next DayIndex
.Columns(aryColumns(7)).Locked = DayIndex = 7
.Protect
End With

End Sub
[/vba]