Check Expiry dates from multiple sheets with a pop up box

[Kjjb]

Hi ,
Surely there must be a thread for my query , but cannot seem to find it .Appreciate your help.
I have a worksheet with 4 sheets named "D1D","D2D","D3D","Misc" . I need to write a VBA to check all the 4 sheets for expiry date ( today()-30) in column E ( range E 7:E135) and then pop message should state Certificates have expired. The pop up box/check should be done when I open the workbook.
Appreciate your help.

Thanks in advance

 

[Legacy 143009]

In the VBA project explorer window double click to ThisWorkbook on the left pane and paste the code.

Private Sub Workbook_Open()
  Dim wsNames() As string
  wsNames = Split("D1D,D2D,D3D,Misc", ",")
  For i = 0 To 3
    With Worksheets(wsNames(i))
      For j = 7 to 135
        If .Cells(j, 5).Value > Now()-30 Then
          MsgBox "Sheet " & wsNames(i) & " Date E" & j & " has expired."
        End If
      Next
    End With
  Next
End Sub

 

[Kjjb]

Hi Flashbond,
THANK YOU for the prompt reply.

However i am getting a runtime error 9 , script out of range
With Worksheets(wsNames(i))
Please assist
Thanks

 

[Legacy 143009]

This error is caused if you don't have sheets named as "D1D","D2D","D3D" or "Misc".

 

[shinigamilight]

Sub works()
      Dim names
      Dim k As Integer
      names = Array("D1D", "D2D", "D3D", "Misc")
      Dim i As Long
      For Each names In Worksheets
            For i = 7 To 135
                If names.Range("E" & i) = Date - 30 Then
                    MsgBox "Sheet name: " & names.Name & vbNewLine & names.Range("E" & i).Address & " Certificates have expired"
                End If
            Next i
     Next names
End Sub

 

[Kjjb]

This error is caused if you don't have sheets named as "D1D","D2D","D3D" or "Misc"

I have just realised it works only for sheet D1D .. then give a run time error. I have attached an image

 

[Kjjb]

Sub works()
      Dim names
      Dim k As Integer
      names = Array("D1D", "D2D", "D3D", "Misc")
      Dim i As Long
      For Each names In Worksheets
            For i = 7 To 135
                If names.Range("E" & i) = Date - 30 Then
                    MsgBox "Sheet name: " & names.Name & vbNewLine & names.Range("E" & i).Address & " Certificates have expired"
                End If
            Next i
     Next names
End Sub

Sub works()
      Dim names
      Dim k As Integer
      names = Array("D1D", "D2D", "D3D", "Misc")
      Dim i As Long
      For Each names In Worksheets
            For i = 7 To 135
                If names.Range("E" & i) = Date - 30 Then
                    MsgBox "Sheet name: " & names.Name & vbNewLine & names.Range("E" & i).Address & " Certificates have expired"
                End If
            Next i
     Next names
End Sub

Hi ,

Tried the code ..nothing happens.

 

[shinigamilight]

Hi ,

Tried the code ..nothing happens.

Are you getting any errors or something?

 

[Kjjb]

I have just realised it works only for sheet D1D .. then give a run time error. I have attached an image

Hi ,

Did a few adjustment to the sheet and now only sheets Misc & various do not work. Getting a run time error ??
Please advise

 

[Kjjb]

Are you getting any errors or something?

no errors ..just nothing happens