Looping through sheets excluding sheet name isn't working

[amartin575]

Hello,

I have the code below which is supposed to loop through all sheets in the workbook except for the one labeled CONSOLIDATED DATA or (Sheet1). It then does a reverse find on column A looking in reverse order for labels that form a table towards the bottom of the data. Once it finds the last label which would be the top of the table it moves up one row and deletes all rows above what it found. It will then clean up the tab some more once I get the code working right. Once that is done it is supposed to move to the next tab and do the same thing until it hits all tabs but the first one. If I run the code on its own on one tab without the loop it works fine. With the loop if I click run from the CONSOLIDATED DATA tab it ignores the exclusion and alters the tab I don't want touched. If I run the loop on one of the other tabs it runs it on that tab. Once it updates the tab it doesn't move at all and tries to run the code on the tab that was just altered and ends up failing at ActiveCell.Offset (-1,0) because at that point the active cell is A1 and it can't move up a -1 from A1. Any idea why the loop isn't moving across all sheets but Sheet1?

Sub FindFromTheBottom()

Dim ws As Worksheet
Dim LastRow As Long
Dim a As Range


    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "CONSOLIDATED DATA" Then
            With ws
                On Error Resume Next
                Set a = .Range("A:A").Find("Strip Center", after:=Cells(1, 1), searchdirection:=xlPrevious)
                a.Cells.Select
                On Error GoTo 0
                On Error Resume Next
                Set a = .Range("A:A").Find("Office Apartment", after:=Cells(1, 1), searchdirection:=xlPrevious)
                a.Cells.Select
                On Error GoTo 0
                On Error Resume Next
                Set a = .Range("A:A").Find("Inline", after:=Cells(1, 1), searchdirection:=xlPrevious)
                a.Cells.Select
                On Error GoTo 0
                On Error Resume Next
                Set a = .Range("A:A").Find("Outparcel", after:=Cells(1, 1), searchdirection:=xlPrevious)
                a.Cells.Select
                On Error GoTo 0
                On Error Resume Next
                Set a = .Range("A:A").Find("Anchor", after:=Cells(1, 1), searchdirection:=xlPrevious)
                a.Cells.Select
                On Error GoTo 0


                ActiveCell.Offset(-1, 0).Select
                Range(Selection, Cells(1)).Select
                Selection.EntireRow.Delete
                Columns("A:A").Select
                Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
                Range("A1").Select
                ActiveCell.FormulaR1C1 = _
                "=MID(CELL(""filename"",RC),FIND(""]"",CELL(""filename"",RC))+1,255)"
 
                LastRow = .Range("C" & Rows.Count).End(xlUp).Row
                .Range("A1").Copy .Range("A1:A" & LastRow)


            End With
        End If
    Next ws


End Sub

 

[wideboydixon]

Some of your code is working on the current sheet. For example, ActiveCell is the active cell on the current sheet. Without refactoring everything else, you could put this before the first "On Error" line:

ws.Activate

WBD

 

[amartin575]

you da man!! Assuming man with wideboydixon as the name. If not I apologize. THANKS FOR THE HELP!