Multiple headers


Hello Everyone

I have create VBA code. And by mistake i have pressed multiple times then it create mutilple header and total are coming. 

So can you you help me that - what should i write in VBA code so it will erase duplicate header and total??

Here is a link for my excel file -!Ak3LKkA3P0qhjkM7v8ahIps7gaKa?e=cOF4mx




You can open this file 



Waiting for your reply...???

9 Replies


Try this:


Sub AddHeaders()
    Do While Range("A1") = "Division"
    Rows("1:1").Insert Shift:=xlDown
    Range("A1") = "Division"
    Range("B1") = "Category"
    Range("C1") = "Jan"
    Range("D1") = "Feb"
    Range("E1") = "Mar"
    Range("F1") = "Total Expense"
End Sub

Sub FormatData()
    With Range("A1:F1")
        With .Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent1
            .TintAndShade = -0.249977111117893
            .PatternTintAndShade = 0
        End With
        With .Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
            .Bold = True
        End With
        .Borders.LineStyle = xlNone
        With .Borders(xlEdgeBottom)
            .LineStyle = xlContinuous
            .ColorIndex = 0
            .TintAndShade = 0
            .Weight = xlMedium
        End With
    End With
    Range(Range("C2"), Range("C2").End(xlToRight).End(xlDown)).Style = "Currency"
End Sub

@Hans Vogelaar 

Thank you for the reply sir. But its not working. And as the header increases , the total becomes double.

I have sent my excel file



You didn't even bother replacing the AddHeaders and FormatData macros with the macros that I posted...

Do that now, and also change the AutoSum macro to


Public Sub AutoSum()
    Dim lastRow As Long
    lastRow = Range("F" & Rows.Count).End(xlUp).Row
    Do While Range("F" & lastRow).Formula Like "=SUM*"
        Range("F" & lastRow).Clear
        lastRow = lastRow - 1
    With Range("F" & lastRow + 1)
        .Formula = "=SUM(F2:F" & lastRow & ")"
        .Font.Bold = True
    End With
End Sub

@Hans Vogelaar 


I wrote this code as you told me. But nothing happened.

Can you fix this file and give it?

Please sir...???




I am attached file


Apparently you haven't run the code. If you run the macros AddHeaders, AutoSum and FormatData, the sheet will look the way you want.

For ease of use I added a macro that calls those three:


Sub Run3Macros()
End Sub


In the attached version, I ran this macro on each of the regional records sheets. The yearly report sheet hasn't been modified.

@Hans Vogelaar 

Thank you so much sir. 

You run the code one by one(AddHeader, FormatData and Autosum)?


Because when i run this code, it didnot works.


And Sir how to delete multiple categories in  YEARLY REPORT tab? 


I have no idea why the code doesn't work for you, sorry. I have tested it several times.

@Hans Vogelaar 

Thank you for help sir. You are Great

@Hans Vogelaar 

Sir i delete the YEARLY REPORT tab then again i recreate it. Then it works.