Solved: Loop through sheets

[BENSON]

The code below works fine ( It indictes wheather all required data has been entered ) ,I would like to alter the code so it will also check the other work sheets to see if all the data has been entered ,not just the current day.
thanks

Private Sub Workbook_Open()
Dim Arr
Dim Dy As String
Arr = Array("TUES", "WED", "THURS", "FRI", "SAT", "SUN", "MON")
Dy = Arr(Weekday(Date, vbTuesday) - 1 + LBound(Arr))
With Worksheets(Dy)
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Value = Dy & " " & _
Format(Date, "d mmmm yyyy")
Dim wSheet As Worksheet
Dim x As Long
Dim LastRow As Long
Application.ScreenUpdating = False
Sheets(1).Select
For Each wSheet In Worksheets
wSheet.Select
LastRow = Range("a" & Rows.Count).End(xlUp).Row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("a1:a" & x), Range("a" & x).Value) > 1 Then
Range("a" & x).EntireRow.Delete
End If
Next x
Next wSheet
Application.ScreenUpdating = True
End With
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim wSheet As Worksheet
Application.ScreenUpdating = False
For Each wSheet In Worksheets



Next



Dim Arr, Dy As Long
Dim Rng As Range, cell As Range
Dim Start As Boolean
Dim Prompt As String, RngStr As String

Prompt = "" & _
"" & vbCrLf & " " & _
"" & _
" " & vbCrLf & vbCrLf & _
"THE CELLS LISTED BELOW AND HIGH LIGHTED YELLOW,HAVE STILL TO BE FILLED WITH DATA:" _
& vbCrLf & vbCrLf

Arr = Array("MON", "TUES", "WED", "THURS", "FRI", "SAT", "SUN")
For Dy = 0 To Weekday(Now, vbMonday) - 1
With Sheets(Arr(Dy))
Start = True
Set Rng = TgtRange(.Name)
'highlights the blank cells
For Each cell In Rng
If cell.Value = vbNullString Then
cell.Interior.ColorIndex = 6 '** color yellow
If Start Then RngStr = RngStr & cell.Parent.Name & vbCrLf
Start = False
RngStr = RngStr & cell.Address(False, False) & ", "
Else
cell.Interior.ColorIndex = 0 '** no color
End If
Next
If RngStr <> "" Then RngStr = Left$(RngStr, Len(RngStr) - 0)
End With
Next
If RngStr <> "" Then
response = MsgBox(Prompt & RngStr & vbCrLf & "DO YOU WISH TO CLOSE THE HISTORY FILE AND COMPLETE LATER?", vbCritical + vbYesNo, "INCOMPLETE HISTORY TRANSFER")
Cancel = (response = vbNo)
Else
'saves the changes before closing
ThisWorkbook.Save
Cancel = False
End If

For Each wSheet In Worksheets

Next
Application.ScreenUpdating = True
End Sub
Function TgtRange(ShtName As String) As Range
With Sheets(ShtName)
Select Case ShtName

Case "TUES"
Set TgtRange = .Cells(.Rows.Count, "A").End(xlUp).Resize(, 25)
Case "WED"
Set TgtRange = .Cells(.Rows.Count, "A").End(xlUp).Resize(, 25)
Case "THURS"
Set TgtRange = .Cells(.Rows.Count, "A").End(xlUp).Resize(, 25)
Case "FRI"
Set TgtRange = .Cells(.Rows.Count, "A").End(xlUp).Resize(, 25)
Case "SAT"
Set TgtRange = .Cells(.Rows.Count, "A").End(xlUp).Resize(, 25)
Case "SUN"
Set TgtRange = .Cells(.Rows.Count, "A").End(xlUp).Resize(, 25)
Case "MON"
Set TgtRange = .Cells(.Rows.Count, "A").End(xlUp).Resize(, 25)
End Select
End With
End Function

[Bob Phillips]

Which part do you want to change? It seems to me that the code already loops through all worksheets at one point, all day named sheets at another.