View Single Post
  #6   Report Post  
Posted to microsoft.public.excel.programming
Bob Phillips[_6_] Bob Phillips[_6_] is offline
external usenet poster
 
Posts: 11,272
Default show msg box if a cell is still blank after a date specified in another cell?

Cameron,

Here's one way to do it
#Option Explicit

Private Sub Workbook_Open()
Const nAgedDays As Long = 30
Dim cLastrow As Long
Dim nTopPos As Long
Dim iWarnings As Long
Dim i As Long
Dim PrintDlg As DialogSheet
Dim CurrentSheet As Worksheet
Dim cb As CheckBox

Application.ScreenUpdating = False

' Check for protected workbook
If ActiveWorkbook.ProtectStructure Then
MsgBox "Workbook is protected.", vbCritical
Exit Sub
End If

' Add a temporary dialog sheet
Set PrintDlg = ActiveWorkbook.DialogSheets.Add


With Worksheets("Sheet1")
cLastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
' Add the checkboxes
nTopPos = 40
For i = 1 To cLastrow
If .Cells(i, "A") + nAgedDays < Date And .Cells(i, "B") = ""
Then
iWarnings = iWarnings + 1
PrintDlg.CheckBoxes.Add 78, nTopPos, 150, 16.5
PrintDlg.CheckBoxes(iWarnings).Text = _
"Row " & i & " - " & Format(.Cells(i, "A").Value, "dd
mmm yyyy")
nTopPos = nTopPos + 13
End If
Next i

' Move the OK and Cancel buttons
PrintDlg.Buttons.Left = 240

' Set dialog height, width, and caption
With PrintDlg.DialogFrame
.Height = Application.Max _
(68, PrintDlg.DialogFrame.Top + nTopPos - 34)
.Width = 230
.Caption = "Select workbooks to process"
End With

' Change tab order of OK and Cancel buttons
' so the 1st option button will have the focus
PrintDlg.Buttons("Button 2").BringToFront
PrintDlg.Buttons("Button 3").BringToFront

.Activate

' Display the dialog box
Application.ScreenUpdating = True
If PrintDlg.Show Then
For Each cb In PrintDlg.CheckBoxes
If cb.Value = xlOn Then
MsgBox Workbooks(cb.Caption).Name & " selected"
End If
Next cb
Else
MsgBox "Nothing selected"
End If

' Delete temporary dialog sheet (without a warning)
Application.DisplayAlerts = False
PrintDlg.Delete

' Reactivate original sheet

End With

End Sub




--

HTH

Bob Phillips
... looking out across Poole Harbour to the Purbecks
(remove nothere from the email address if mailing direct)

"****cameron**** " wrote in message
...
thanks again Bob,
Yeah I want to have them trigger when the workbook opens and have each
case have a reminder open in order of oldest tp latest. I am starting
to think these guys aren't paying me enough....


---
Message posted from http://www.ExcelForum.com/