Ignore sheet in loop

[cuetipper]

So how do I ignore the worksheet named "Data".

For Each ws In Sheets
if ws.name="Data" next ws end if
else
'do stuff here
next ws

 

[Fluff]

Making the 2 changes i showed in red in post#17, I get no errors.

 

[cuetipper]

Well that's a bummer as I do. I do not know what to do now.
Thanks.

 

[Fluff]

It should be like

Sub OpenOrders()
em = InputBox("Email  [Y/N] ")
TDD = Range("A3")
'Trim Sheet
    Cells.Select
    Selection.Locked = False
    Selection.FormulaHidden = False
    Selection.UnMerge
    Selection.ColumnWidth = 8
    Rows("1:4").Select
    Selection.Delete Shift:=xlUp
'Add Calcs
' Add Date Columns
    Range("S1").Select
    ActiveCell.FormulaR1C1 = "DAYS LATE"
    Range("T1").Select
    ActiveCell.FormulaR1C1 = "GRACE"
    Range("U1").Select
    ActiveCell.FormulaR1C1 = "DATE"
    Range("V1").Select
    ActiveCell.FormulaR1C1 = "LATE"
    Range("S2").Select
    ActiveCell.FormulaR1C1 = "=RC[2]-RC[1]"
    Range("T2").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(RC[-14]=""P1"",""4"",IF(RC[-14]=""P2"",""7"",IF(RC[-14]=""p3"",""21"","""")))"
    Range("U2").Select
    ActiveCell.FormulaR1C1 = "=DAYS(TODAY(),RC[-9])"
    Range("V2").Select
    ActiveCell.FormulaR1C1 = "=IF(VALUE(RC[-1])>VALUE(RC[-2]),""Y"",""N"")"
    Range("W2").Select
'Fill sheet
'Format
 Range("S1:V2").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
'Cells
   Lr = Range("A1").End(xlDown).Row
    Range("S2:V2").Select
    Selection.AutoFill Destination:=Range("S2:V" & Lr), Type:=xlFillDefault
    'Move Late Column
    Columns("s:s").Select
    Selection.Cut
    Columns("Q:Q").Select
    Selection.Insert Shift:=xlToRight
    Range("Q1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 4.99893185216834E-02
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .Color = -16711681
        .TintAndShade = 0
    End With
'Delete if not late
    For Lr = Range("a" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Range("v" & Lr).Value = "n" Then Rows(Lr).EntireRow.Delete
    If Range("v" & Lr).Value = "N" Then Rows(Lr).EntireRow.Delete
    Next
'trim xs columns
    Range("D:D,E:E,H:H,K:K").Select
    Selection.Delete Shift:=xlToLeft
'Sort
    awsn = ActiveSheet.Name
    Lr = Range("A1").End(xlDown).Row
    Cells.Select
    ActiveWorkbook.Worksheets(awsn).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(awsn).Sort.SortFields.Add key:=Range("G2:G" & Lr)
    ActiveWorkbook.Worksheets(awsn).Sort.SortFields.Add key:=Range("D2:D" & Lr)
    ActiveWorkbook.Worksheets(awsn).Sort.SortFields.Add key:=Range("C2:C" & Lr)
    With ActiveWorkbook.Worksheets(awsn).Sort
    .SetRange Range("A1:n" & Lr)
    .Header = xlYes
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
'Add tab naming field
    Columns("G:G").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("G2").Select
    ActiveCell.FormulaR1C1 = "=LEFT(RC[1],30)"
    Range("G2").Select
    Selection.AutoFill Destination:=Range("G2:G" & Lr)
    Range("G2:G" & Lr).Select
    Selection.Copy
    Selection.PasteSpecial paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
'Remove  special charectors
    With Columns("G:G")
    .Replace What:="\", Replacement:=""
    .Replace What:="/", Replacement:=""
    .Replace What:="-", Replacement:=" "
    .Replace What:="(", Replacement:=""
    .Replace What:=")", Replacement:=""
    .Replace What:=",", Replacement:=""
    .Replace What:="&", Replacement:=""
    .Replace What:=".", Replacement:=""
    End With
'Parse Sheets
   awsn = ActiveSheet.Name
   Lr = Range("A1").End(xlDown).Row
   With Worksheets(awsn)
   .Range("A1:T" & Lr).Value = .Evaluate("INDEX(PROPER(A1:T" & Lr & "),)")
   End With
   Set ws = Sheets(awsn)
   If ws.AutoFilterMode Then ws.AutoFilterMode = False
   With CreateObject("scripting.dictionary")
   For Each Cl In ws.Range("G2", ws.Range("G" & Rows.Count).End(xlUp))
   If Not .Exists(Cl.Value) Then
   Sheets.Add.Name = Cl.Value
   .Add Cl.Value, Nothing
   ws.Range("A1:T1").AutoFilter 7, Cl.Value
   ws.AutoFilter.Range.Copy Worksheets(Cl.Value).Range("A1")
'Format for email
    Columns("G:G").Select
    Selection.Delete Shift:=xlToLeft
    Cells.Select
    Selection.ColumnWidth = 254
    Cells.EntireRow.AutoFit
    Cells.EntireColumn.AutoFit
   End If
   Next Cl
   End With
   
   
   
  '  Sheets("Open Vendor Jobs").Delete
   
   
  ' GoTo snd
    
    
    'Create Summary Sheet
    If ActiveSheet.Name = "Summary" Then
    Application.DisplayAlerts = False
    Worksheets("Summary").Delete
    Application.DisplayAlerts = True
    End If
    WS_Count = ActiveWorkbook.Sheets.Count
'Create New Summary Sheet
    Worksheets.Add Before:=Worksheets(1)
    ActiveSheet.Name = "Summary"
'Count last row in column A across all sheets
    For i = 2 To WS_Count + 1
    Lr = ActiveWorkbook.Sheets(i).Cells(Rows.Count, "A").End(xlUp).Row - 1
    With Sheets("Summary")
    .Cells(i, 1).Value = Sheets(i).Name
    .Cells(i, 2).Value = Lr
    End With
    Next i
' Align Top
    Range("A1:B1").Select
    Selection.Delete Shift:=xlUp
    Cells.Select
    Cells.EntireColumn.AutoFit
    Lr = Range("A1").End(xlDown).Row
'Sort
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add key:=Range("B1:B" & Lr), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    ActiveWorkbook.Worksheets("Summary").Sort.SortFields.Add key:=Range("A1:A" & Lr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Summary").Sort
    .SetRange Range("A1:B" & Lr)
    .Header = xlGuess
    .MatchCase = False
    Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
    End With
snd:
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If em = "Y" Then GoTo nxt1
If em = "y" Then GoTo nxt1
End
nxt1:
'Email Section
    For Each ws In Application.Worksheets
    If ws.Name <> "Summary" And ws.Name <> "Open Vendor Jobs" Then
    ws.Activate
   ' If WS.Name = "Summary"
   ' If WS.Name = "Open Vendor Jobs"
'Get Recipient
    sal = Range("N2")
    VND = Range("G2")
' Create top lines of the email body
    sHtmlHeader = VND & "," _
    & vbLf & vbLf _
    & "Below you will see a current summary of your job(s) that appear to be open and have not satisfied City?s response and/or completion requirements." _
    & vbLf _
    & "If these jobs are actually completed, please return to the worksite as soon as possible to finalize the job close-out process in Mercury." _
    & vbLf _
    & "For all jobs still in progress, please ensure the latest update is added into Mercury." _
    & vbLf _
    & "If for any reason you cannot complete these jobs, please respond with the issue you're encountering so we can help. " _
    & vbLf _
    & vbLf & vbLf _
    & "As an FYI, City?s priorities are listed below. Please make all attempts to meet these requirements as they directly impact Walmart store operations. " _
    & vbLf _
    & "*? P1 ? 4 Hour Response, Completed in 4 Days." _
    & vbLf _
    & "*? P2 ? 24 Hour Response, Completed in 7 Days." _
    & vbLf _
    & "*? P3 - 7 Day Response, Completed in 21 Days." _
    & vbLf _
    & vbLf & vbLf _
    & "We appreciate your continued partnership in servicing Walmart." _
    & vbLf _
    & "If you have any questions or concerns please contact us at wmtsubcontractors@cfm-us.com. " _
    & vbLf & vbLf
    sHtmlHeader = Replace(sHtmlHeader, vbLf, Chr(60) & "br" & Chr(62))
'User setting, change to suit
    Const FontName = "Arial"
    Const FontSize = 10
    Const Behalf = "wmtsubcontractors@cfm-us.com" ' <-- Name to send on behalf of Exchange profile/account
    Dim objOutlookApp As Object
    Dim IsOutlookCreated As Boolean
    Dim sFont As String, sText As String, sTempHTMLFile As String
' Set font of html-body (parentheses are just because of MrExcel posting limitation)
    sFont = "(body font: " & FontSize & "pt " & FontName & ";color:black"")(/p)"
    sFont = Replace(sFont, "(", Chr(60))
    sFont = Replace(sFont, ")", Chr(62))
'Copy range     Application.CutCopyMode = False
    Lr = Range("A1").End(xlDown).Row
    ActiveSheet.Range("A1:M" & Lr).Copy
' Get HTML data
    sTempHTMLFile = Environ("Temp") & "\Temp_for_Excel" & Format(Now, "YYYYMMDD_hhmmssms") & ".htm"
    With Workbooks.Add(xlWBATWorksheet)
' Paste data special
    With .Sheets(1).Cells(1)
    .PasteSpecial xlPasteValues
    .PasteSpecial xlPasteColumnWidths
    .PasteSpecial xlPasteFormats
    End With
    Application.CutCopyMode = False
' Publish HTML file data
    With .PublishObjects.Add(xlSourceRange, sTempHTMLFile, .Sheets(1).Name, .Sheets(1).UsedRange.Address, xlHtmlStatic)
    .Publish True
    End With
' Read the HTML file data
    sText = CreateObject("Scripting.FileSystemObject").OpenTextFile(sTempHTMLFile).ReadAll
' Close the created aux workbook
    .Close False
' Kill the HTML file
    Kill sTempHTMLFile
  End With
' Get/Create an Outlook instance
    On Error Resume Next
    Set objOutlookApp = GetObject(, "Outlook.Application")
    If Err Then
    Set objOutlookApp = CreateObject("Outlook.Application")
    IsOutlookCreated = True
    End If
    On Error GoTo 0
' Create a new email, fill it and send
    With objOutlookApp.CreateItem(0)
' Set HTML format
    .BodyFormat = 2
' Get default email signature without blinking (instead of .Display method)
    With .GetInspector: End With
    sSignature = .htmlbody
' Apply left aligning
    sText = Replace(sText, "align=center x:publishsource=", "align=left x:publishsource=")
' Concatenate all parts for HtmlBody
    sText = sFont & sHtmlHeader & sText & sSignature
' Insert sText into HtmlBody
    .htmlbody = sText
'*******************************************************************************************************
    'Specify email recipients, subject, etc:
    .To = sal
    '.Cc = "carboncopy@..."
    .Subject = "- Expired Eta Report for -   " & VND & "  ---  " & TDD
    .SentOnBehalfOfName = Behalf
   '.Send '<-- Directly send out this email, use .Display instead for the debugging only
    .display
  End With
'Prevent memory leakage
  Set objAccount = Nothing
   End If
Next
 ' Quit Outlook instance if it was created by this code
    If IsOutlookCreated Then
    objOutlookApp.Quit
    Set objOutlookApp = Nothing
    End If
End Sub

Does this give you an error?

 

[cuetipper]

It WORKS! Awesome. I will need to read thru it to see what you changed so I can learn. Thank you very much.

On another note. As you taught me to use the hash tag to enter code, is there a quick way to highlight all the code to copy?

 

[Fluff]

I tend to click the # icon & then paste the code between the tags.

 

[cuetipper]

Yes, that is what you said ealier. i was wondering when trying to copy from the forum if there was an easy way to select all?

 

[Fluff]

I thought that you were talking about pasting the code & then selecting it to add the code tags.
When copying the code from the thread, I know of no shortcut.

 

[cuetipper]

As always, thanks.

 

[Countryboy69]

You can try clicking at the beginning of your code then scroll to the bottom and hit shift+right click. That should select the entire code. Then ctrl+c to copy, ctrl+v to paste