Remove duplicate headers

I have looked at many solutions to this but not one of the work for me, for whatever reason.

Can an Expert provide me with VBA code that will remove duplicate headers

I am copying all sheets onto one sheet and then I sort the data which leaves me with maybe 5, 6,7 headers. I need to remove all but the first header.

Thanks
JagwarmanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Martin LissOlder than dirtCommented:
Can you supply a sample workbook so I can see what you mean by "duplicate headers"?
0
Roy CoxGroup Finance ManagerCommented:
Surely it's better not to import unnecessary headers.

Try this code

'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 09/05/2007 08:43
' Author    : Roy Cox (royUK)
' Website   : www.excel-it.com for more examples and Excel Consulting
' Purpose   : combine data from multiple sheets to one
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

'---------------------------------------------------------------------------------------
Option Explicit

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim DataRng As Range
    Dim Rw As Long

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> ActiveSheet.Name Then
            Rw = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
            If Rw = 1 Then
                Set DataRng = ws.Cells(1, 1).CurrentRegion
                DataRng.Copy ActiveSheet.Cells(Rw, 1)
            Else: Rw = Rw + 1
                'don't copy header rows
                DataRng.Offset(1, 0).Resize(DataRng.Rows.Count - 1, _
                                            DataRng.Columns.Count).Copy ActiveSheet.Cells(Rw, 1)
            End If
        End If
    Next ws

End Sub

Open in new window

0
SteveCommented:
Apply a filter to the header row.
Filter on the header row data
Then select all rows except the top row.
Press [ctrl]+[minus on num pad] together.
Then unfilter.
( no need to sort data first, but filter must include all rows of data )
0
Cloud Class® Course: Microsoft Azure 2017

Azure has a changed a lot since it was originally introduce by adding new services and features. Do you know everything you need to about Azure? This course will teach you about the Azure App Service, monitoring and application insights, DevOps, and Team Services.

Saurabh Singh TeotiaCommented:
I'm assuming this question is originating as a followup from the previous one..In that case you can run this code and this will copy only the headers one time not multiple times...

Sub MOVEDATA()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Set ws1 = Sheets("Summary")

    ws1.Cells.Clear


    For Each ws In ActiveWorkbook.Worksheets

        If ws.Name <> ws1.Name Then

            If ws1.Range("B1").Value = "" Then
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws.Range("B1:U" & lrow).Copy ws1.Range("B1")
            Else
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
               if lrow>1 then ws.Range("B2:U" & lrow).Copy ws1.Range("B" & lr)
            End If
        End If

    Next ws
End Sub

Open in new window

0
JagwarmanAuthor Commented:
Saurabh Singh Teotia

that still brings In the headers
0
Saurabh Singh TeotiaCommented:
It should not..Can you post your sample workbook to have a look as it should not get you headers...
0
JagwarmanAuthor Commented:
file as requested
Test-File-1205.xlsm
0
Saurabh Singh TeotiaCommented:
You got headers in row-2 rather then row-1..Use this code...

Sub MOVEDATA()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Set ws1 = Sheets("Summary")

    ws1.Cells.Clear


    For Each ws In ActiveWorkbook.Worksheets

        If ws.Name <> ws1.Name Then

            If ws1.Range("B1").Value = "" Then
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws.Range("B2:U" & lrow).Copy ws1.Range("B1")
            Else
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
               If lrow > 1 Then ws.Range("B3:U" & lrow).Copy ws1.Range("B" & lr)
            End If
        End If

    Next ws
End Sub

Open in new window


Saurabh...
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Roy CoxGroup Finance ManagerCommented:
Code amended for attached example


'---------------------------------------------------------------------------------------
' Module    : Module1
' DateTime  : 09/05/2007 08:43
' Author    : Roy Cox (royUK)
' Website   : www.excel-it.com for more examples and Excel Consulting
' Purpose   : combine data from multiple sheets to one
' Disclaimer; This code is offered as is with no guarantees. You may use it in your
'             projects but please leave this header intact.

'---------------------------------------------------------------------------------------
Option Explicit

Private Sub CommandButton1_Click()

    Dim ws As Worksheet
    Dim DataRng As Range
    Dim Rw As Long

    For Each ws In ThisWorkbook.Worksheets
        If ws.Name <> ActiveSheet.Name Then
            Rw = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
            Set DataRng = ws.Cells(2, 2).CurrentRegion
            If Rw = 1 Then
                DataRng.Copy ActiveSheet.Cells(Rw, 2)
            Else: Rw = Rw + 1
                'don't copy header rows
                DataRng.Offset(1, 0).Resize(DataRng.Rows.Count - 1, _
                                            DataRng.Columns.Count).Copy ActiveSheet.Cells(Rw, 2)
            End If
        End If
    Next ws

End Sub

Open in new window

0
JagwarmanAuthor Commented:
roy, I ran yours and it still does not get rid of the duplicates.
0
JagwarmanAuthor Commented:
Saurabh Singh Teotia

Thanks that's perfect
0
Saurabh Singh TeotiaCommented:
Jagwarman,

You can run this code and it will exclude any hidden worksheets from the data to copy...

Sub MOVEDATA()
    Dim ws As Worksheet, ws1 As Worksheet
    Dim lrow As Long, lr As Long

    Set ws1 = Sheets("Summary")

    ws1.Cells.Clear


    For Each ws In ActiveWorkbook.Worksheets

        If ws.Name <> ws1.Name And ws.Visible = xlSheetVisible Then

            If ws1.Range("B1").Value = "" Then
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                ws.Range("B2:U" & lrow).Copy ws1.Range("B1")
            Else
                lrow = ws.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                lr = ws1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
               If lrow > 1 Then ws.Range("B3:U" & lrow).Copy ws1.Range("B" & lr)
            End If
        End If

    Next ws
End Sub

Open in new window


Saurabh...
0
JagwarmanAuthor Commented:
many thanks
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Excel

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.