While Deleting Repeated Headers-CodePudding

Using the below code to delete the repeated headers from combined into one excel but getting error.

  Application.Goto DestSh.Cells(1)

   ' AutoFit the column width in the summary sheet.
   DestSh.Columns.AutoFit

   With Application
       .ScreenUpdating = True
       .EnableEvents = True
   End With
   
   Dim xWs As Worksheet
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   For Each xWs In Application.ActiveWorkbook.Worksheets
       If xWs.Name <> "Combined Sheet" Then
           xWs.Delete
       End If
   Next
   Application.DisplayAlerts = True
   Application.ScreenUpdating = True
   
   Dim lstRow As Integer, ws As Worksheet
       Set ws = ThisWorkbook.Sheets("Combined Sheet")
       With ws
       lstRow = .Cells(rows.Count, "B").End(xlUp).Row ' Or "C" or "A" depends

       .Range("A1:E" & lstRow).SpecialCells(xlCellTypeBlanks).EntireRow.Delete   ERROR GETTING HERE

   End With

enter image description here

CodePudding user response：

Please add "on error resume next" before using SpecialCells method and after using use "on error GoTo 0"

Hope it will help

Rajesh

CodePudding user response：

    .SpecialCells(xlCellTypeBlanks)

This expression gives you every blank cell in a Range. Rows that you are going to delete includes non-blank cells also, so vba will not delete them. You can try a RemoveDuplicates method like:

    .Range("A1:E" & lstRow).RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5), Header :=xlNo

It can be not safe to use the method, but for your task it's may be Ok.

This sub is a safe variant to delete your headers. you can call the sub by the Call statement, and don't forget to set your header address.

    Call removeHeaders()

    Sub removeHeaders()
    Dim hdrRangeAdr As String
    Dim l, frstRow, lstRow, offsetRow As Long
    Dim counter, row1, row2 As Integer
    Dim item As Variant
    Dim hdrRng, tRng As Range
    Dim ws As Worksheet
        
        ' setting of the first header address
        hdrRangeAdr = "A1:O1"
        Set ws = ThisWorkbook.Sheets("Combined Sheet")
        ' setting of the header range
        Set hdrRng = ws.Range(hdrRangeAdr)
        hdrRowsQty = hdrRng.Rows.Count
        frstRow = hdrRng.Row
        lstRow = hdrRng.Parent.UsedRange.Rows.Count   frstRow
        
        'checking row by row
        For l = 1 To lstRow - frstRow
            offsetRow = l   hdrRowsQty - 1
            counter = 0
            ' compare row/rows value with the header
            For Each item In hdrRng.Cells
                If item = item.Offset(offsetRow, 0) Then
                    counter = counter   1
                End If
            Next
            
            ' if they are equial then delete rows
            If counter = hdrRng.Count Then
                row1 = frstRow   offsetRow
                row2 = row1   hdrRowsQty - 1
                ws.Rows(row1 & ":" & row2).Delete Shift:=xlUp
                'reseting values as rows qty reduced
                l = 1
                lstRow = hdrRng.Parent.UsedRange.Rows.Count   frstRow
            End If
        Next
        
        Set ws = Nothing
        Set hdrRng = Nothing
        
    End Sub

Good luck