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

 

[JoeMo]

Untested, but see if this modification does what you want on a copy of your workbook.

Sub CreateSheetsFromCostObjects()
Dim ws As Worksheet, Ct As Long, c As Range, i As Long
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
        For i = Cells(Rows.Count, "C").End(xlUp).Row To 3
            If Cells(i, "C").Value <> Range("A1").Value Then Cells(i, "C").EntireRow.Delete
        Next i
    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 skipped right past deleting the rows. Here is the formula that I have in A1 =MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,256).

 

[JoeMo]

It skipped right past deleting the rows. Here is the formula that I have in A1 =MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,256).

Your formula is OK, think I missed some sheet qualifiers. Still untested, but see if this modification helps:

Sub CreateSheetsFromCostObjects()
Dim ws As Worksheet, Ct As Long, c As Range, i As Long
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
        With ActiveSheet
            For i = .Cells(.Rows.Count, "C").End(xlUp).Row To 3
                If .Cells(i, "C").Value <> .Range("A1").Value Then .Cells(i, "C").EntireRow.Delete
            Next i
        End With
    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]

I appreciate the help. It still created the sheets without deleting the rows.

 

[JoeMo]

I appreciate the help. It still created the sheets without deleting the rows.

Just to ensure we are on the same mission, you create a sheet and give it a tab name that also appears in cell A1 of the new sheet by virtue of your formula. Then you wish to examine each cell in the used range of col C in the new sheet, starting in cell C3, and if the cell does not have the tab name that's in A1 in it, then you want to delete the entire row that cell is in. Is that correct?

If yes, can you post some sample data to show me what the new sheet looks like when the delete rows part of the procedure begins execution?

 

[benntw]

Correct, I copy a sheet that has over 6000 lines of data on it. Column C is the searchable range. If it does not equal the value in A1, that is a formula to show the sheet name, then it needs to delete the entire row. Hopefully this shows correctly when I paste it. This is from A1 to C7. xxx00000232 is in A1. I couldn't actually copy the data that is in my spreadsheet, but for visual I changed the sheet name and data in columns A thru C.

xxx00000232
Vendor Description	Labor Group	Proj Def Code
John doe	John doe Secondary In	xxx00000222
John doe	John doe Secondary In	xxx00000222
John doe	John doe Secondary In	xxx00000222
John doe	John doe Secondary In	xxx00000222
John doe	John doe Secondary In	xxx00000222

<colgroup><col><col><col></colgroup><tbody>
</tbody>

<colgroup><col><col><col><col></colgroup><tbody></tbody>

 

[JoeMo]

So it appears there are lots of rows that should be deleted. And you observe that the sheets get created but no rows are deleted. I can't see how that can be from afar. Can you place a break point at this line:

ActiveSheet.Name = c.Value

then step through the loop (use the F8 key) that's intended to delete rows that don't meet the =A1 criterion and see what's happening?

 

[benntw]

When I step through the code it highlights the following in yellow. With ActiveSheet, For i = .Cells(.Rows.Count, "C").End(xlUp).Row To 3, End With. It skips over If .Cells(i, "C").Value <> .Range("A1").Value Then .Cells(i, "C").EntireRow.Delete & Next i.

 

[JoeMo]

When I step through the code it highlights the following in yellow. With ActiveSheet, For i = .Cells(.Rows.Count, "C").End(xlUp).Row To 3, End With. It skips over If .Cells(i, "C").Value <> .Range("A1").Value Then .Cells(i, "C").EntireRow.Delete & Next i.

That's not the code I gave you. Can you copy the code from post #4 directly from your browser and overwrite whatever you have there now with a paste, then try again?