Delete repeating header rows

[fddekker]

Hope somebody can help with this one:

I am running a macro to combine several files into a single worksheet. After the single sheet has been created, only the top row's header entries should remain. I thus want to delete all rows that are exactly like row 1.

The header entries are not always the same - sometimes there are 20 columns, sometimes 50 columns, and the entries depend on the files being brought in - but fortunately all the header rows that are brought in are always the same. I thus need a macro that will check row 1, and then delete all rows that are similar to row 1, delete them, but leave row 1 intact.

All help much appreciated.

 

[oldbrewer]

the macro could sort by col a then col b then col c and compare a2 with a1, b2 with b1 etc etc and if all pairs are the same delete row 2

macro would then restart from beginning ie now comparing what was row 3 with row 1

first part you can get code with macro record then it is something like

For j=1 to 60
if cells(2,j)<>cells(1,j) >>> match so continue loop
dont match so end macro
next j
all matches so delete row 2

end sub

 

[sheetspread]

Pass the header to an array or string (I believe this can only be done with a loop), delete it from the worksheets, combine the worksheets, and reinsert the header.

If there's a term that only appears in the header, you can simply delete its subsequent occurences.

 

[Jack in the UK]

Something to try, always on copy for your workbook, in case in mess ups

jiuk

Sub test_MyHEADER_REmove()

'// jiuk - Should kinda work, something to try, all headers should be the same
'//        from each worksheet etc
'//        Written by Jack in the UK - 8/10/2014 from v
'//    jiuk - feed - /forum/excel-questions/285608-remove-duplicate-headers-current-worksheet.html

Dim myCount As Long
Dim myHEADER As String

myHEADER = "Change to what ever you like" '// jiuk - change to Your requirements

Application.ScreenUpdating = False

For myCount = ActiveSheet.UsedRange.Rows.Count To 1 Step -1

If Cells(myCount, 1) = myHEADER Then
'// jiuk - change to Your requirements from 1 to the column you want the string to be in

Rows(myCount).Select
Selection.Delete shift:=x1UP

End If

Next myCount

Application.ScreenUpdating = True
End Sub

 

[fddekker]

Thanks for the advice.

I am currently using something similar to what Jack proposes, by searching for "Period_Name" in Column "E" and deleting all such rows except 1 (with a loop).
It works fine for a group of files where I know the cell values of row 1, but I want to use the macro as an add-in so that it could be used for any combined file (but where I do NOT know the contents of any of the cell values that will make up row 1; or how many columns are actually populated - so I don't want to specify what the macro should be looking for, Excel should check row 1 and if it finds it again, delete the row)
I do not want to sort, so that the original "files" still occupy a continuous block in the worksheet, as they are provided by different users, and could be needed for reconciliation purposes.

 

[oldbrewer]

can duplicate header rows appear anywhere in the spreadsheet, if so my try via sorting then comparing rows 1 and 2 would work......

 

[Jack in the UK]

This code will deltet rows with teh same text as in cell A1, feel free to try on copy of Your workbook and try / edit to suite

jiuk

Sub test_MyHEADER_REmove_V2()

'// jiuk - Should kinda work, something to try, all headers should be the same
'//        from each worksheet etc
'//        Written by Jack in the UK - 9/10/2014
'//    jiuk - feed - /forum/excel-questions/285608-remove-duplicate-headers-current-worksheet.html

Dim myCount As Long
Dim myHEADER As String


'// jiuk - **********************************
' myHEADER = "Change to what ever you like" '// jiuk - change to Your requirements
myHEADER = ThisWorkbook.Sheets(1).Range("a1").Value
'// jiuk - **********************************

Application.ScreenUpdating = False

For myCount = ActiveSheet.UsedRange.Rows.Count To 1 Step -1

If Cells(myCount, 1) = myHEADER Then
'// jiuk - change to Your requirements from 1 to the column you want the string to be in

Rows(myCount).Select
Selection.Delete shift:=x1UP

End If

Next myCount

Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

I am running a macro to combine several files into a single worksheet. After the single sheet has been created, only the top row's header entries should remain.

My first thought (a bit similar to sheetspread's) is to alter your existing macro so that when combining, it only brings in data below the headings for all except the first file so that you wouldn't have to worry about deleting anything.

However, if that is not feasible or the files you are combining already have repeating header rows themselves, then I have a couple of alternatives below. I note that you said you did not want to sort the data. My codes do sort, but they should do so in a way that keeps all the original rows in their respective orders.

Test in a copy of your workbook.


A. Is it sufficient to just check column A for repeats of cell A1, like Jack's idea in post #7? If so, this should be considerably faster.

Sub DeleteRepeatHeadings1()
  Dim lr As Long, lc As Long, i As Long, j As Long
  Dim a As Variant, b As Variant
  Dim Hdr As String
  
  Application.ScreenUpdating = False
  lr = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row + 1
  lc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range("A1").Resize(lr).Value
  ReDim b(1 To lr, 1 To 1)
  Hdr = a(1, 1)
  For i = 2 To lr
    If a(i, 1) <> Hdr Then b(i, 1) = 1
  Next i
  With Range("A1").Resize(lr, lc)
    .Columns(lc).Value = b
    .Sort Key1:=.Columns(lc), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    .Columns(lc).Offset(1).SpecialCells(xlBlanks).EntireRow.Delete
    .Columns(lc).ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

B. If you want to check that all columns in a row match row 1 before deleting that row, then try this version.

Sub DeleteRepeatHeadings2()
  Dim lr As Long, lc As Long, i As Long, j As Long
  Dim a As Variant, b As Variant
 
  Application.ScreenUpdating = False
  lr = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
    SearchOrder:=xlByRows, SearchDirection:=xlPrevious, SearchFormat:=False).Row + 1
  lc = Cells.Find(What:="*", After:=Cells(1, 1), LookIn:=xlValues, _
    SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, SearchFormat:=False).Column + 1
  a = Range("A1").Resize(lr, lc).Value
  ReDim b(1 To lr, 1 To 1)
  For i = 2 To lr
    j = 1
    Do While a(i, j) = a(1, j) And j < lc
      j = j + 1
    Loop
    If j < lc Then b(i, 1) = 1
  Next i
  With Range("A1").Resize(lr, lc)
    .Columns(lc).Value = b
    .Sort Key1:=.Columns(lc), Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, _
      MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
    .Columns(lc).Offset(1).SpecialCells(xlBlanks).EntireRow.Delete
    .Columns(lc).ClearContents
  End With
  Application.ScreenUpdating = True
End Sub

 

[fddekker]

Peter_SSs
I want to make it universal that several groups of files can be combined, so did not wanted to test on just one column.
Tested the second block of code on several of the examples ... and success. Exactly what I needed to improve on my code. (Already added into my add-in!)

Thanks!