Delete row not equal to value in A1 for each sheet

[benntw]

My worksheet creates copied sheets from a list. The list is from the values in column C. What I want to do is after it copies and renames the sheet, search column C for values that don't match A1. A1 is the a formula to equal the sheet name. My data in column C starts on the 3rd row. Below is my code to copy and rename each sheet. The number of sheets depends on how many cost objects I have in my list. I hope someone can help on this. Thank you.

Sub CreateSheetsFromCostObjects()

Dim ws As Worksheet, Ct As Long, c As Range

Set ws = Worksheets("EditReport")

Application.ScreenUpdating = False

For Each c In Sheets("SheetNames").Range("A2:A40")
If c.Value <> "" Then
ws.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = c.Value
Ct = Ct + 1
End If
Next c
If Ct > 0 Then
MsgBox Ct & " new sheets created from list"
Else
MsgBox "No names on list"
End If

Call CreateHyperlinks

Sheets("SheetNames").Select

Application.ScreenUpdating = True
End Sub

 

[benntw]

It took less than 1 minute to complete the entire code I had in there. I never even gave it a thought on how you ended up writing it.

 

[JoeMo]

Thanks for the info.