I work with MS Excel spreadsheets that have data with the same column headings (in the first row). The headings have unique filters applied.

I have VBA code to manipulate the data (omit certain columns, highlight cells, sort, etc.). It works on any of my spreadsheets individually.

The problem comes in when I amalgamate/join multiple spreadsheet data into one spreadsheet (by hitting ctrl + A, copying, and pasting the data and headings directly below the rest on one spreadsheet).
The code throws an error because of the multiple heading rows.

My fix, once I've pasted all data and headings onto one spreadsheet, is to highlight each heading row (except for the first one) and hit the delete button.
Or when I copy the data and headings from each of the spreadsheets into one, I highlight the data manually and leave out the heading row.

How can I, using VBA code, delete those heading rows.

I tried this code from ChatGPT. I get

No filters applied!

If I comment out that if/else check, it generates

run-time error ‘1004’ Delete method of Range class failed.

on

ws.Rows(foundCell.Row).Delete

Sub DeleteFilteredRows()
    Dim ws As Worksheet
    Dim rng As Range
    Dim searchRange As Range
    Dim foundCell As Range
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Worksheets("special") ' Adjust the worksheet name
    
        ' Turn off filters to ensure proper deletion
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    Else
        MsgBox "No filters applied!", vbExclamation
        Exit Sub
    End If
    
    ' Define the range to search in (exclude the header row)
    Set searchRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' Find and delete rows containing "PARENT_NM"
    Set foundCell = searchRange.Find(What:="PARENT_NM", LookIn:=xlValues, LookAt:=xlWhole)
    
    Do While Not foundCell Is Nothing
        ws.Rows(foundCell.Row).Delete
        Set searchRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' Redefine search range
        Set foundCell = searchRange.Find(What:="PARENT_NM", LookIn:=xlValues, LookAt:=xlWhole)
    Loop
End Sub

I work with MS Excel spreadsheets that have data with the same column headings (in the first row). The headings have unique filters applied.

I have VBA code to manipulate the data (omit certain columns, highlight cells, sort, etc.). It works on any of my spreadsheets individually.

The problem comes in when I amalgamate/join multiple spreadsheet data into one spreadsheet (by hitting ctrl + A, copying, and pasting the data and headings directly below the rest on one spreadsheet).
The code throws an error because of the multiple heading rows.

My fix, once I've pasted all data and headings onto one spreadsheet, is to highlight each heading row (except for the first one) and hit the delete button.
Or when I copy the data and headings from each of the spreadsheets into one, I highlight the data manually and leave out the heading row.

How can I, using VBA code, delete those heading rows.

I tried this code from ChatGPT. I get

No filters applied!

If I comment out that if/else check, it generates

run-time error ‘1004’ Delete method of Range class failed.

on

ws.Rows(foundCell.Row).Delete

Sub DeleteFilteredRows()
    Dim ws As Worksheet
    Dim rng As Range
    Dim searchRange As Range
    Dim foundCell As Range
    
    ' Set the worksheet
    Set ws = ThisWorkbook.Worksheets("special") ' Adjust the worksheet name
    
        ' Turn off filters to ensure proper deletion
    If ws.AutoFilterMode Then
        ws.AutoFilterMode = False
    Else
        MsgBox "No filters applied!", vbExclamation
        Exit Sub
    End If
    
    ' Define the range to search in (exclude the header row)
    Set searchRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
    
    ' Find and delete rows containing "PARENT_NM"
    Set foundCell = searchRange.Find(What:="PARENT_NM", LookIn:=xlValues, LookAt:=xlWhole)
    
    Do While Not foundCell Is Nothing
        ws.Rows(foundCell.Row).Delete
        Set searchRange = ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row) ' Redefine search range
        Set foundCell = searchRange.Find(What:="PARENT_NM", LookIn:=xlValues, LookAt:=xlWhole)
    Loop
End Sub

• excel
• vba

• Is the worksheet protected? – Tim Williams Commented Jan 29 at 23:05

3 Answers 3

A bit simpler:

Sub DeleteMatchedRows()
    
    Const DEL_VAL As String = "PARENT_NM" 'header to look for
    Dim ws As Worksheet, c As Range, rngDel As Range
    
    Set ws = ThisWorkbook.Worksheets("special")
    For Each c In ws.Range("A2", ws.Cells(ws.Rows.count, "A").End(xlUp)).Cells
        If c.Value = DEL_VAL Then BuildRange rngDel, c 'collect this cell
    Next c
    
    'if any cells got matched then delete those rows
    If Not rngDel Is Nothing Then rngDel.EntireRow.Delete

End Sub

'Add range `rngAdd` to range `tngTot`
Sub BuildRange(ByRef rngTot As Range, rngAdd As Range)
    If rngTot Is Nothing Then
        Set rngTot = rngAdd
    Else
        Set rngTot = Application.Union(rngTot, rngAdd)
    End If
End Sub

Filter the first column and delete the filtered rows.

Sub Demo()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("special") ' Adjust the worksheet name
    If ws.AutoFilterMode Then ws.AutoFilterMode = False
    Const KEY_VAL = "PARENT_NM"
    Application.ScreenUpdating = False
    With Range("A1").CurrentRegion
        .AutoFilter Field:=1, Criteria1:=KEY_VAL
        Dim rTab As Range, rVis As Range
        Set rTab = .Resize(.Rows.Count - 1, .Columns.Count - 1).Offset(1, 1)
        On Error Resume Next
        Set rVis = rTab.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If rVis Is Nothing Then
            MsgBox "No matching rows"
        Else
            rVis.EntireRow.Delete
        End If
        .AutoFilter
    End With
    Application.ScreenUpdating = True
End Sub

Microsoft documentation:

Range.Offset property (Excel)

Range.Resize property (Excel)

The problem comes in when I want to amalgamate/join multiple spreadsheet data into one spreadsheet (by hitting ctrl + A, copying, and pasting the data directly below the rest on one spreadsheet) and then execute the Macro once. It throws an error because of the multiple heading columns.

btw, You can create a script to consolidate data from multiple sheets or files while skipping duplicate headers during the process, ensuring they don’t become an issue.

Copying and pasting rows as values consumes more resources compared to directly assigning values to the target range. Pls try the revised script.

Sub MergeMySheets()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, targetRow As Long
    Dim wb As Workbook, ColCnt As Long
    Dim sheetNames As Variant, srcRng As Range
    Dim i As Integer
    
    ' Define the sheet names to copy from
    sheetNames = Array("s1", "s2", "s3", "s4", "s5", "s6", "s7", "s8") ' Update as needed
    
    ' Create a new worksheet for the filtered data
    Set wb = ThisWorkbook
    
    ' Check if the sheet exists before proceeding
    On Error Resume Next
    Set wsTarget = wb.Sheets("special")
    On Error GoTo 0 ' Reset error handling
    If Not wsTarget Is Nothing Then
        ' Clear existing data in target sheet
        wsTarget.Cells.Clear
    Else
        Set wsTarget = wb.Sheets.Add
    End If
    
    targetRow = 1 ' Start pasting from the first row
    Dim firstSheet As Boolean: firstSheet = True ' Flag to track the first sheet
    
    ' Loop through the defined sheet names
    For i = LBound(sheetNames) To UBound(sheetNames)
        ' Check if the sheet exists before proceeding
        On Error Resume Next
        Set wsSource = wb.Sheets(sheetNames(i))
        On Error GoTo 0 ' Reset error handling
        
        ' If the sheet does not exist, skip it
        If Not wsSource Is Nothing Then
            ' Find last used row in source sheet
            lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
            ColCnt = wsSource.UsedRange.Columns.Count
            ' Only copy if the sheet contains data
            If Not VBA.IsEmpty(wsSource.Cells(lastRow, 1)) Then
                If firstSheet Then
                    ' First sheet: Copy everything (including headers)
                    Set srcRng = wsSource.Range("A1", wsSource.Cells(lastRow, ColCnt))
                    firstSheet = False ' Mark that we've processed the first sheet
                Else
                    ' Other sheets: Exclude the header (start from row 2)
                    If lastRow > 1 Then
                        Set srcRng = wsSource.Range("A2", wsSource.Cells(lastRow, ColCnt))
                    Else
                        ' If only header exists, skip this sheet
                    End If
                End If
                If Not srcRng Is Nothing Then
                    ' Paste values into target sheet
                    With srcRng
                        wsTarget.Cells(targetRow, 1).Resize(.Rows.Count, .Columns.Count).Value = .Value
                    End With
                End If
                ' Update next target row
                targetRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
            End If
        End If
        
        ' Reset wsSource for the next loop
        Set wsSource = Nothing
        Set srcRng = Nothing
    Next i
    
    ' MsgBox "Data merged successfully! Now running the primary script.", vbInformation
    
    ' Call the primary script on the merged data
    Call FilterDataAndCreateSummary
    
End Sub

Thank you, taller. In your little "btw" comment beneath your code response, you helped me realise that there is a smarter way of managing my problem. By changing my approach, and using your RowOffset idea, this makes my process a lot simpler. Instead of manually copying data from multiple sheets into one before running my primary script, I can create a script that does that for me (omitting the annoying header rows) and then immediately running my primary script afterwards.

So, I hopped back onto chatGPT to get it to write me a script just for that, and with a little back and forth in the prompts and a little tweaking on my end, here is the final (working) result:

    Sub MergeMySheets()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRow As Long, targetRow As Long
    Dim wb As Workbook
    Dim sheetNames As Variant
    Dim i As Integer
    
    ' Define the sheet names to copy from
    sheetNames = Array("s1", "s2", "s3", "s4", "s5", "s6", "s7", "s8") ' Update as needed
    
     ' Create a new worksheet for the filtered data
    Set wb = ThisWorkbook
    Set wsTarget = wb.Sheets.Add
    wsTarget.Name = "special" ' Change as needed

    ' Clear existing data in target sheet
    wsTarget.Cells.Clear
    targetRow = 1 ' Start pasting from the first row
    firstSheet = True ' Flag to track the first sheet
    
    ' Loop through the defined sheet names
    For i = LBound(sheetNames) To UBound(sheetNames)
        ' Check if the sheet exists before proceeding
        On Error Resume Next
        Set wsSource = wb.Sheets(sheetNames(i))
        On Error GoTo 0 ' Reset error handling
        
        ' If the sheet does not exist, skip it
        If Not wsSource Is Nothing Then
            ' Find last used row in source sheet
            lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row

            ' Only copy if the sheet contains data
            If lastRow > 0 Then
                If firstSheet Then
                    ' First sheet: Copy everything (including headers)
                    wsSource.Range(wsSource.Cells(1, 1), wsSource.Cells(lastRow, wsSource.Columns.Count)).Copy
                    firstSheet = False ' Mark that we've processed the first sheet
                Else
                    ' Other sheets: Exclude the header (start from row 2)
                    If lastRow > 1 Then
                        wsSource.Range(wsSource.Cells(2, 1), wsSource.Cells(lastRow, wsSource.Columns.Count)).Copy
                    Else
                        ' If only header exists, skip this sheet
                        GoTo NextSheet
                    End If
                End If
                
                ' Paste values into target sheet
                wsTarget.Cells(targetRow, 1).PasteSpecial Paste:=xlPasteValues
                Application.CutCopyMode = False

                ' Update next target row
                targetRow = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
            End If
        End If
        
        NextSheet:
        ' Reset wsSource for the next loop
        Set wsSource = Nothing
    Next i

    ' MsgBox "Data merged successfully! Now running the primary script.", vbInformation

    ' Call the primary script on the merged data
    Call FilterDataAndCreateSummary

End Sub

How This Code Works

✔ Loops through a predefined list of sheets (sheetNames), but skips any that may not be present in the workbook.

✔ Copies all the data from the first sheet and then only data rows (excluding headers) from the other sheets.

✔ Appends data in a continuous manner on "special".

✔ After merging, it automatically calls the primary script (FilterDataAndCreateSummary) to process the final dataset.

Happy days!