VBA - Manipulate Specific Sheet Data With Macro - Not Activesheet

Question

I have 10 sheets in a workbook - These sheets were imported from individual workbooks - These workbooks were extracts from different monitoring tools

I need to apply a filter across all 10 worksheets, however, not all the sheets are in the same format/structure.

With 6 of the worksheets, the column headers are the same and in the same order.

The remaining 4 sheets have different headers. For example: The filter needs to look for a header name Status - This works for the 6 sheets that have the same structure, however, the other 4 sheets have the following:

wsheet1:

User Status instead of Status - I need to change the header to Status

wsheet2:

Current_Status instead of Status - I need to change the header to Status

Below is sample code that is supposed to manipulate the specified sheet in in order to have it "look" the same as the others, however, I am having some really annoying issues where the code isn't applied to the sheet specified and is instead applied to the "Activesheet" when the macro is executed.

Here is the code I have:

Sub arrangeSheets()

    Dim lastCol As Long, idCount As Long, nameCount As Long, headerRow As Long

    Dim worksh As Integer, WS_Count As Integer, i As Integer, count As Integer

    Dim rng As Range, cel As Range, rngData As Range

    Dim worksheetexists As Boolean

            worksh = Application.Sheets.count
            worksheetexists = False

            headerRow = 1       'row number with headers
            lastCol = Cells(headerRow, Columns.count).End(xlToLeft).Column 'last column in header row
            idCount = 1
            nameCount = 1


            ' Set WS_Count equal to the number of worksheets in the active
            ' workbook.
            WS_Count = ActiveWorkbook.Worksheets.count

            'If Application.Match finds no match it will throw an error so we need to skip them
            On Error Resume Next

            For x = 1 To worksh

                If Worksheets(x).Name = "wsheet1" Then
                    worksheetexists = True

                    Set rng = Sheets("wsheet1").Range(Cells(headerRow, 1), Cells(headerRow, lastCol)) 'header range

                    With Worksheets("wsheet1").Name

                        Rows(2).Delete
                        Rows(1).Delete
                        count = Application.Match("*USER STATUS*", Worksheets("wsheet1").Range("A1:AZ1"), 0)

                        If Not IsError(count) Then
                            For Each cel In rng                     'loop through each cell in header
                                If cel = "*USER STATUS*" Then       'check if header is "Unit ID"

                                    cel = "STATUS" & idCount        'rename "Unit ID" using idCount
                                    idCount = idCount + 1           'increment idCount

                                End If
                            Next cel
                        End If

                    End With

            Exit For

                End If

            Next x
            End Sub

Answer 1

I have additional solution which has also helped with this issue. Code below:

Sub ManipulateSheets()

    Dim worksh As Integer

    Dim worksheetexists As Boolean

    worksh = Application.Sheets.count
    worksheetexists = False

    'If Application.Match finds no match it will throw an error so we need to skip them
    On Error Resume Next

    Worksheets("wSheet1").Activate

    With Worksheets("wSheet1")

        .Rows(2).Delete
        .Rows(1).Delete
    End With

    Worksheets("wSheet2").Activate

    With Worksheets("wSheet2")

        .Rows(2).Delete

    End With

End Sub

Answer 2

If you want the same headers across all sheets in the workbook you could just copy the headers from the first sheet and paste them on each sheet.

This wouldn't work if your column order is different across sheets, but from the example you gave it's just renaming columns rather than re-ordering?

Sub CorrectHeaders()

    Dim cpyRng As Range

    With ThisWorkbook
        If .Worksheets.count > 1 Then

            With .Worksheets(1)
                Set cpyRng = .Range(.Cells(1, 1), .Cells(1, .Columns.count).End(xlToLeft))
            End With

            .Sheets.FillAcrossSheets cpyRng

        End If
    End With

End Sub

If the column headers are in different orders, but you just want to replace any cell that contains the text "Status" with just "Status" then you could use Replace. You may want to add an extra condition of MatchCase:=True.

Sub Correct_Status()

    Dim wrkSht As Worksheet

    For Each wrkSht In ThisWorkbook.Worksheets
        wrkSht.Cells(1, 1).EntireRow.Replace What:="*Status*", Replacement:="Status", LookAt:=xlWhole
    Next wrkSht

End Sub

Answer 3

• Consider using ., in the With-End with section to refer to the Worksheet mentioned:

• The Like in If cel Like "*USER STATUS*" works with the *, thus will be evaluated to True for 12USER STATUS12 or anything similar.

• The count variable should be declared as variant, thus it can keep "errors" in itself.

This is how the code could look like:

With Worksheets("wsheet1")

    .Rows(2).Delete
    .Rows(1).Delete
    Count = Application.Match("*USER STATUS*", .Range("A1:AZ1"), 0)

    If Not IsError(Count) Then
        For Each cel In Rng                     'loop through each cell in header
            If cel Like "*USER STATUS*" Then    'check if header is "Unit ID"
                cel = "STATUS" & idCount        'rename "Unit ID" using idCount
                idCount = idCount + 1           'increment idCount    
            End If
        Next cel
    End If

End With