Multiple headers

Iron Contributor

Hello Everyone:smiling_face_with_smiling_eyes:

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 - 

 

https://1drv.ms/x/s!Ak3LKkA3P0qhjkM7v8ahIps7gaKa?e=cOF4mx

 

or

 

You can open this file 

 

 

Waiting for your reply...???

9 Replies

@Excel 

Try this:

 

Sub AddHeaders()
    Do While Range("A1") = "Division"
        Range("A1").EntireRow.Delete
    Loop
    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

 

@Excel 

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
    Loop
    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

@Excel 

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()
    AddHeaders
    AutoSum
    FormatData
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? 

@Excel 

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:smiling_face_with_smiling_eyes::smiling_face_with_smiling_eyes:

@Hans Vogelaar 

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