vba popup message to notify empty cell

Hi, attached workbook is a common file used for data entry by a few of my staff. At some point in time, they will need to move files into another drive and check off Column Q after they have done so. The problem is, they sometimes forget to move the files due to their busy schedule. What i hope to add to this workbook is a code that can check if Column Q has been checked everytime the workbook is opened. If it has not been checked, look up column Column G and add 5 days to it. So the popup message will appear on the 5th day onwards, everyday, until the files have been moved and Column Q has been checked off.

The popup message ideally should have the case number (located in Column A) and the tab name, if not it will be time consuming to look through every sheet to find the problematic row.

Any help is appreciated

Hi bqheng,

See the attached file (containing the code below) which is a modified copy of your Workbook. A UserForm is displayed when the Workbook Opens that contains a list of each item that is 5 or more days overdue. 'Double Clicking' any item in the List, will go to that item.

To display the list again, 'Double Click' cell 'R1' (TAT) on any sheet.

In the ThisWorkbook code module:

Private Sub Workbook_Open()
  'frmCaseLog.Show
      
  'Display the UserForm for OverDue Items
  Call DisplayUserForm1
  
End Sub


Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)

  Dim sValue As String

  'Display UserForm1 if Cell 'R1' is 'Double Clicked' and contains the text 'TAT'
  If Not Intersect(Target, Range("R1")) Is Nothing Then
  
    'Get the value in the cell (UPPER CASE) remove leading/trailing spaces
    'NOTE: 'Resize' needed due to possible 'Merged Cell'
    sValue = UCase(Trim(Target.Resize(1, 1).Value))
    If sValue = "TAT" Then
    
      'Return Normal Focus to Excel
      Cancel = True
      
      'Display the UserForm for OverDue Items
      Call DisplayUserForm1
      
    End If
  
  End If
  
End Sub

In the UserForm1 code module:

Private Sub UserForm_Initialize()

  Call PopulateUserForm1ListBox1

End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

  Dim iListBoxRow As Long
  Dim iRow As Long
  
  Dim sSheetName As String
  
  'Get the ListBox Row Number
  iListBoxRow = ListBox1.ListIndex

  'MsgBox "The Values in ListBox1 are:" & vbCrLf & _
         "Row Number 0 = " & iListBoxRow & vbCrLf & _
         "Column 0 = " & ListBox1.List(iListBoxRow, 0) & vbCrLf & _
         "Column 1 = " & ListBox1.List(iListBoxRow, 1) & vbCrLf & _
         "Column 2 = " & ListBox1.List(iListBoxRow, 2) & vbCrLf & _
         "Column 3 = " & ListBox1.List(iListBoxRow, 3) & vbCrLf & _
         ""
         
  'Ignore Row 0 - Header Row
  'Process all other rows
  If iListBoxRow > 0 Then
  
    'Get the 'Sheet Name' and 'Row Number'
    sSheetName = ListBox1.List(iListBoxRow, 0)
    iRow = CLng(ListBox1.List(iListBoxRow, 4))
    
    'Go there
    Sheets(sSheetName).Select
    Sheets(sSheetName).Cells(iRow, "R").Select
    
    'Close the UserForm
    Unload Me
    
  End If
         
End Sub

In ordinary code module ModUserForm1:

Option Explicit

Sub HideColumnsForEasierDebugging()
  'This is a debugging tool
  
  Dim wks As Worksheet
  
  Dim sSheetName As String
  Dim sValueG1 As String
  Dim sValueQ1 As String

  For Each wks In ThisWorkbook.Worksheets
    sSheetName = wks.Name
    
    'Get the possible Sentinel Values - remove leading/trailing spaces
    sValueG1 = Trim(wks.Range("G1").Value)
    sValueQ1 = Trim(wks.Range("Q1").Value)
    
    'Process this sheet only if the Sheet contains the Sentinel values
    If sValueG1 = "Date Cut" And sValueQ1 = "Archived in Q?" Then
      
      'Hide Columns 'H' thru 'P'
      wks.Range("H:P").EntireColumn.Hidden = True
    
    End If
    
  Next wks

End Sub

Sub UnHideColumnsThatWereHiddenForEasierDebugging()
  'This is a debugging tool
  
  Dim wks As Worksheet
  
  Dim sSheetName As String
  Dim sValueG1 As String
  Dim sValueQ1 As String

  For Each wks In ThisWorkbook.Worksheets
    sSheetName = wks.Name
    
    'Get the possible Sentinel Values - remove leading/trailing spaces
    sValueG1 = Trim(wks.Range("G1").Value)
    sValueQ1 = Trim(wks.Range("Q1").Value)
    
    'Process this sheet only if the Sheet contains the Sentinel values
    If sValueG1 = "Date Cut" And sValueQ1 = "Archived in Q?" Then
      
      'UnHide Columns 'H' thru 'P'
      wks.Range("H:P").EntireColumn.Hidden = False
    
    End If
    
  Next wks

End Sub

Sub DisplayUserForm1()
  UserForm1.Show vbModal
  'UserForm1.Show vbModeless
End Sub

Sub PopulateUserForm1ListBox1()
  'This puts data into the UserForm ListBox
  '
  'ListBox Columns are:
  '0 = Tab Name
  '1 = Case No.
  '2 = Date Cut
  '3 = Days OverDue
  '4 = SpreadSheet Row Number (not displayed)

  Dim wks As Worksheet
  
  Dim myDate As Date
  
  Dim i As Long
  Dim iDaysOverdue As Long
  Dim iLastRowUsed As Long
  Dim iListBoxRow As Long
  Dim iRow As Long
  
  Dim sCheckMarkValue As String
  Dim sCaseNumber As String
  Dim sDateCut As String
  Dim sSheetName As String
  Dim sValueG1 As String
  Dim sValueQ1 As String

  'Initialize the UserForm ListBox
  UserForm1.ListBox1.Clear
  iListBoxRow = -1
        
  'Process Each Sheet that has:
  'a. 'Date Cut' in cell 'G1' and
  'b. 'Archived in Q?' in cell 'Q1'
  For Each wks In ThisWorkbook.Worksheets
    sSheetName = wks.Name
    
    'Get the possible Sentinel Values - remove leading/trailing spaces
    sValueG1 = Trim(wks.Range("G1").Value)
    sValueQ1 = Trim(wks.Range("Q1").Value)
    
    'Process this sheet only if the Sheet contains the Sentinel values
    If sValueG1 = "Date Cut" And sValueQ1 = "Archived in Q?" Then
      'Debug.Print sSheetName
      
      'Get the Last Row Used on the Sheet in Column 'A'
      On Error Resume Next
      iLastRowUsed = 0
      iLastRowUsed = wks.Range("A:A").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
      If Err.Number <> 0 Then
        Err.Clear
      End If
      On Error GoTo 0
      
      For iRow = 3 To iLastRowUsed
      
        'Get the Data Values for the Row (remove leading/trailing spaces)
        sCaseNumber = Trim(wks.Cells(iRow, "A").Value)
        sDateCut = Trim(wks.Cells(iRow, "G").Value)
        sCheckMarkValue = Trim(wks.Cells(iRow, "Q").Value)
        
        'Process the Row only if there is NO CHECKMARK (Marlett Font 'a')
        If sCheckMarkValue <> "a" Then
        
          'Initialize the number of days between now and 'Date Cut'
          iDaysOverdue = 0
        
          'Calculate the number of days between now and 'Date Cut'
          If IsDate(sDateCut) Then
          
            'Convert the String to a Date
            myDate = CDate(sDateCut)
            
            'Calculate the number of days between now and 'Date Cut'
            iDaysOverdue = Date - myDate
            
            'Debug.Print Format(myDate, "ddd mmmm d, yyyy"), iDaysOverdue
          
          End If
        
        
          'Process only if the number of days between now and 'Date Cut'
          'is greater than the day threshhold
          If iDaysOverdue >= 5 Then
          
            'Add 'Pseudo' Header data to the ListBox
            If iListBoxRow = -1 Then
      
              'Increment the ListBox Row Number
              iListBoxRow = iListBoxRow + 1
            
              'Add data to the Listbox
              UserForm1.ListBox1.AddItem
              UserForm1.ListBox1.List(iListBoxRow, 0) = "Tab Name"
              UserForm1.ListBox1.List(iListBoxRow, 1) = "Case No."
              UserForm1.ListBox1.List(iListBoxRow, 2) = "Date Cut"
              UserForm1.ListBox1.List(iListBoxRow, 3) = "Days Overdue"
              UserForm1.ListBox1.List(iListBoxRow, 4) = 0
            
            End If
          
            'Increment the ListBox Row Number
            iListBoxRow = iListBoxRow + 1
            
            'Add data to the Listbox
            UserForm1.ListBox1.AddItem
            UserForm1.ListBox1.List(iListBoxRow, 0) = sSheetName
            UserForm1.ListBox1.List(iListBoxRow, 1) = sCaseNumber
            UserForm1.ListBox1.List(iListBoxRow, 2) = Format(myDate, "ddd mmmm d, yyyy")
            UserForm1.ListBox1.List(iListBoxRow, 3) = iDaysOverdue
            UserForm1.ListBox1.List(iListBoxRow, 4) = iRow
          
          End If
        
        End If
      
      Next iRow
    
    End If
    
  Next wks
  
  'Update the 'Status' Display (Label1)
  If iListBoxRow = -1 Then
    UserForm1.Label1.Caption = "All items are less than 5 days overdue."
  ElseIf iListBoxRow = 1 Then
    UserForm1.Label1.Caption = iListBoxRow & " item is 5 or more days overdue." & vbCrLf & _
                               "'Double Click' a Line in the ListBox to go to that entry in the Workbook."
  Else
    UserForm1.Label1.Caption = iListBoxRow & " items are 5 or more days overdue." & vbCrLf & _
                               "'Double Click' a Line in the ListBox to go to that entry in the Workbook."
  End If
  
End Sub

Lewis

Thank you LJMetzger!!