Cannot supress Display alert Message

[howard]

I have the following code below

However when running the code, I get a message :"the following features cannot be saved in macro-free workbooks....

I want code to automatically select "Yes" and not to see this message

Also if Col H2 onwards is blank on sheet Macro , then macro to exit (I have formulas that result in a blank based on certain criteria)

When running the macro sheet1 is being created, which should not happen if if H2 onwards are blank

Kindly mend my code

Sub Email_Sheets()
    Dim ws As Worksheet
    Dim sFile As String, strBody As String, sName As String, strTo As String
    Dim filteredRange As Range, rng As Range
    Dim wsArr()
    Dim lr As Long, n As Long, i As Long
   
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
   
    Set ws = Sheets("Macro")
    lr = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
   
    For i = 2 To lr
        If ws.Range("J" & i).EntireRow.Hidden = False And ws.Range("J" & i).Value <> "" Then
            sName = ws.Range("J" & i).Value
            strTo = strTo & ws.Range("I" & i).Value & ";"
            ReDim Preserve wsArr(n)
            wsArr(n) = sName
            n = n + 1
        End If
    Next
   
    If n > 1 Then sName = "Guys"
    strBody = "Hi " & sName & vbNewLine & vbNewLine & _
        "Attached, please find Variance Reports pertaining to your branch" & vbNewLine & vbNewLine & _
        "Please attend to the variances and advise once corrected" & vbNewLine & vbNewLine & _
        "Regards" & vbNewLine & vbNewLine & _
        "Howard"
   
    sFile = ThisWorkbook.Path & "\" & "Stats Variances.xlsx"
   
    Dim newWB As Workbook ' Create a new workbook to copy the sheets
    Set newWB = Workbooks.Add
   
    Dim wb As Workbook
    Set wb = ThisWorkbook
    Dim wsMacro As Worksheet
    Set wsMacro = wb.Sheets("Macro")
   
    ' Check if column H is empty or not visible
    Dim lastRowH As Long
    lastRowH = wsMacro.Cells(wsMacro.Rows.Count, "H").End(xlUp).Row
   
    If lastRowH < 2 Or wsMacro.Columns("H").Hidden Then
        MsgBox "No sheets to attach.", vbInformation
        Exit Sub
    End If
   
    ' Check if column H has any valid sheet names
    Dim hasValidSheet As Boolean
    hasValidSheet = False
   
    For i = 2 To lastRowH
        sName = wsMacro.Range("H" & i).Value
        If sName <> "" And WorksheetExists(CStr(sName), wb) Then
            hasValidSheet = True
            Exit For
        End If
    Next i
   
    If Not hasValidSheet Then
        MsgBox "No sheets to attach.", vbInformation
        Exit Sub
    End If
   
    For i = 2 To lastRowH
        sName = wsMacro.Range("H" & i).Value
        If WorksheetExists(CStr(sName), wb) Then
            wb.Sheets(CStr(sName)).Copy After:=newWB.Sheets(newWB.Sheets.Count)
        End If
    Next i
   
    On Error Resume Next ' Ignore errors if "Sheet1" doesn't exist
    Application.DisplayAlerts = False
    newWB.Sheets("Sheet1").Delete
    Application.DisplayAlerts = True
    On Error GoTo 0
   
    With newWB
        .SaveAs Filename:=sFile, FileFormat:=51
        .Close savechanges:=False
    End With
   
    With CreateObject("Outlook.Application").CreateItem(0)
        .Display
        .To = strTo
        .Subject = "Variance Report"
        .Body = strBody
       
        .Attachments.Add sFile
    End With
   
    Kill sFile
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub

Function WorksheetExists(sheetName As String, wb As Workbook) As Boolean
    On Error Resume Next
    WorksheetExists = Not wb.Sheets(sheetName) Is Nothing
    On Error GoTo 0
End Function

 

[Georgiboy]

Try moving this line:

Application.DisplayAlerts = True

Below this part:

    With newWB
        .SaveAs Filename:=sFile, FileFormat:=51
        .Close savechanges:=False
    End With

 

[howard]

Thanks GeorgiBoy. This works perfectly regarding supressing the message

Where H2 onwards is blank, I need the code amended to Exit Sub. However if H2 onwards is blank, it creates a workbook with sheet1, which I don't want if there is nothing in this column on sheet Macro

 

[Georgiboy]

Try moving this part:

    Dim newWB As Workbook ' Create a new workbook to copy the sheets
    Set newWB = Workbooks.Add

After this part:

    ' Check if column H is empty or not visible
    Dim lastRowH As Long
    lastRowH = wsMacro.Cells(wsMacro.Rows.Count, "H").End(xlUp).Row
   
    If lastRowH < 2 Or wsMacro.Columns("H").Hidden Then
        MsgBox "No sheets to attach.", vbInformation
        Exit Sub
    End If

That way it will Exit Sub before it creates the new workbook

 

[howard]

Many Thanks Georgiboy

Your suggestion solved the issue