Checking project data

[paddy69]

I have a code that check all task during opening a project however it displays a warning for each individual task in MSP. What I would like is a message box that shows all found tasks at once.
Any suggestions anyone? Thanks.
[vba]Sub XPLN_OSCH()
Dim T As Integer
Dim Msg, Style, Title, Response
With ActiveProject
For T = 1 To .Tasks.Count
If .Tasks(T).Summary = True Then
If InStr(.Tasks(T).EnterpriseText23, "XPLN") > 0 Then
If .Tasks(T).EnterpriseFlag1 = True Then
Msg = "Order Nr " & .Tasks(T).EnterpriseText1 & " has User Status ""XPLN"" and On Schedule is ""Yes""" & Chr(13) & Chr(13) & "Please change On Schedule into ""No"" and/or contact the responsible Job Leader to discuss timelines" ' Define message.
Style = vbOKOnly + vbCritical + vbDefaultButton2
Title = "Check MSP"
Response = MsgBox(Msg, Style, Title)
End If
End If
End If
Next T

End With
End Sub[/vba]

[Oorang]

See if this will do it:
[vba]Option Explicit

Public Sub XPLN_OSCH()
'Constants used in message box:
Const strTitle_c As String = "Check MSP"
Const strStatus_c As String = "xpln"
Const strTxtHdr_c As String = "The following Order Nr(s) have User-" & _
"Status """ & strStatus_c & """ and On-" & _
"Schedule of ""Yes"":" & vbLf
Const strTxtFtr_c As String = vbLf & vbLf & "Please change On Schedule " & _
"into ""No"" and/or contact the " & _
"responsible Job Leader to discuss " & _
"timelines."
Const strMsgNtFnd_c As String = "No anomalies found."
Const strBlt_c As String = vbLf & vbTab & "• "
Dim prjActv As MSProject.Project
Dim tskCrnt As MSProject.Task
Dim strMsg As String

'Turn on error handling:
On Error GoTo Err_Hnd

'Set to working status:
DisableInterface

'Get Active Project:
Set prjActv = MSProject.ActiveProject

'Iterate through all project tasks:
For Each tskCrnt In prjActv.Tasks
'Only look at summary tasks:
If tskCrnt.Summary Then
'Use LCase$ to force case *in*sensitive search for status. Implicit
'boolean conversion makes any value not 0 = "True":
If InStr(LCase$(tskCrnt.EnterpriseText23), strStatus_c) Then
'If status is found then check for flag:
If tskCrnt.EnterpriseFlag1 = True Then
'If flagged, save to report to user:
strMsg = strMsg & (strBlt_c & tskCrnt.EnterpriseText1)
End If 'End of EnterpriseFlag1 Check
End If 'End of EnterpriseText23 Check
End If 'End of Summary Check
Next tskCrnt

'Only display messege if item is found. Implicit boolean conversion makes
'any value not 0 = "True":
If LenB(strMsg) Then
'Add text header/footer:
strMsg = strTxtHdr_c & strMsg & strTxtFtr_c
'Display Message:
MsgBox strMsg, vbOKOnly + vbExclamation, strTitle_c
Else
'Disply "Not Found" message:
MsgBox strMsgNtFnd_c, vbOKOnly + vbExclamation, strTitle_c
End If

'******* Exit Procedure *******
Exit_Proc:
'Supress Error Handling to Prevent Error-Loops:
On Error Resume Next
'Release Objects:
Set tskCrnt = Nothing
Set prjActv = Nothing
'Re-enable interface:
EnableInterface
Exit Sub
'******* Error Handler *******
Err_Hnd:
MsgBox Err.Description, vbSystemModal + vbCritical, "Error: " & Err.Number
Resume Exit_Proc
End Sub

Private Sub DisableInterface()
On Error Resume Next
With MSProject.Application
.ScreenUpdating = False
.EnableCancelKey = pjErrorHandler
.StatusBar = "Working..."
End With
End Sub

Private Sub EnableInterface()
On Error Resume Next
With MSProject.Application
.ScreenUpdating = True
.EnableCancelKey = pjInterrupt
.StatusBar = False
End With
End Sub
[/vba]