How to make my VBA command run on several worksheets

[teksiong]

Hi,

I have one workbook with several worksheets, however when i run it, it only run on one worksheet. Can anyone help me to make this code also run for other worksheets in the same workbook?

Here is the code:

Private Sub Workbook_Open()
Dim LRow As Long
Dim LName As String
Dim LResponse As String
Dim LResponse1 As String
Dim LDiff As Long
Dim LDays As Long

LRow = 2 'start at row 2
LDays = 90 'Warning - Number of days to check for expiration

With Sheets("SIP01 Crew")
'Check the first 100 rows in column I
While LRow < 100
'Only check for expired certificate if value in column I is not blank
If IsDate(.Range("I" & LRow)) Then
LDiff = .Range("I" & LRow).Value2 - Date
If (LDiff >= 0) And (LDiff <= LDays) Then
'Get names
LName = .Range("B" & LRow).Value
LName1 = .Range("C" & LRow).Value
LName2 = .Range("E" & LRow).Value
LName3 = .Range("G" & LRow).Value
LResponse = LResponse & LName & " " & LName1 & " " & LName2 & " " & LName3 & " " & " will expire in " & LDiff & " days." & Chr(10)
End If
If (LDiff <= 0) Then
'Get names
LName = .Range("B" & LRow).Value
LName1 = .Range("C" & LRow).Value
LName2 = .Range("E" & LRow).Value
LName3 = .Range("G" & LRow).Value
LResponse = LResponse & LName & " " & LName1 & " " & LName2 & " " & LName3 & " " & " already expired for " & LDiff & " days." & Chr(10)
End If
End If
LRow = LRow + 1
Wend
If CBool(Len(LResponse)) Then _
MsgBox "These Certificate(s) are already due or nearing expiration:" & Chr(10) & LResponse, vbCritical, "Warning"
End With
End Sub

and i wish the the message box pop up for each worksheet.

Hopefully someone can help me

Agus

 

[Ombir]

Try this:

Private Sub Workbook_Open()
Dim sh  As Worksheet
Dim LRow As Long
Dim LName As String
Dim LResponse As String
Dim LResponse1 As String
Dim LDiff As Long
Dim LDays As Long

LRow = 2 'start at row 2
LDays = 90 'Warning - Number of days to check for expiration


For Each sh In ActiveWorkbook.Worksheets

    With sh
    'Check the first 100 rows in column I
        While LRow < 100
    'Only check for expired certificate if value in column I is not blank
            If IsDate(.Range("I" & LRow)) Then
            LDiff = .Range("I" & LRow).Value2 - Date
                If (LDiff >= 0) And (LDiff <= LDays) Then
                'Get names
                    LName = .Range("B" & LRow).Value
                    LName1 = .Range("C" & LRow).Value
                    LName2 = .Range("E" & LRow).Value
                    LName3 = .Range("G" & LRow).Value
                    LResponse = LResponse & LName & " " & LName1 & " " & LName2 & " " & LName3 & " " & " will expire in " & LDiff & " days." & Chr(10)
                End If
                If (LDiff <= 0) Then
                'Get names
                    LName = .Range("B" & LRow).Value
                    LName1 = .Range("C" & LRow).Value
                    LName2 = .Range("E" & LRow).Value
                    LName3 = .Range("G" & LRow).Value
                    LResponse = LResponse & LName & " " & LName1 & " " & LName2 & " " & LName3 & " " & " already expired for " & LDiff & " days." & Chr(10)
                End If
            End If
        LRow = LRow + 1
        Wend
        
        If CBool(Len(LResponse)) Then _
            MsgBox "These Certificate(s) are already due or nearing expiration:" & Chr(10) & LResponse, vbCritical, "Warning"
    End With
Next

End Sub