Multiple headers

%3CLINGO-SUB%20id%3D%22lingo-sub-2083813%22%20slang%3D%22en-US%22%3EMultiple%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2083813%22%20slang%3D%22en-US%22%3E%3CP%3EHello%20Everyone%3Asmiling_face_with_smiling_eyes%3A%3C%2FP%3E%3CP%3EI%20have%20create%20VBA%20code.%20And%20by%20mistake%20i%20have%20pressed%20multiple%20times%20then%20it%20create%20mutilple%20header%20and%20total%20are%20coming.%26nbsp%3B%3C%2FP%3E%3CP%3ESo%20can%20you%20you%20help%20me%20that%20-%20what%20should%20i%20write%20in%20VBA%20code%20so%20it%20will%20erase%20duplicate%20header%20and%20total%3F%3F%3C%2FP%3E%3CP%3EHere%20is%20a%20link%20for%20my%20excel%20file%20-%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CSTRONG%3E%3CA%20href%3D%22https%3A%2F%2F1drv.ms%2Fx%2Fs!Ak3LKkA3P0qhjkM7v8ahIps7gaKa%3Fe%3DcOF4mx%22%20target%3D%22_blank%22%20rel%3D%22noopener%20nofollow%20noreferrer%22%3Ehttps%3A%2F%2F1drv.ms%2Fx%2Fs!Ak3LKkA3P0qhjkM7v8ahIps7gaKa%3Fe%3DcOF4mx%3C%2FA%3E%3C%2FSTRONG%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%3CSTRONG%3Eor%3C%2FSTRONG%3E%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EYou%20can%20open%20this%20file%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3CP%3EWaiting%20for%20your%20reply...%3F%3F%3F%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-LABS%20id%3D%22lingo-labs-2083813%22%20slang%3D%22en-US%22%3E%3CLINGO-LABEL%3EMacros%20and%20VBA%3C%2FLINGO-LABEL%3E%3C%2FLINGO-LABS%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2084037%22%20slang%3D%22en-US%22%3ERe%3A%20Multiple%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2084037%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F811137%22%20target%3D%22_blank%22%3E%40Zan_Hanifee%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3ETry%20this%3A%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3ESub%20AddHeaders()%0A%20%20%20%20Do%20While%20Range(%22A1%22)%20%3D%20%22Division%22%0A%20%20%20%20%20%20%20%20Range(%22A1%22).EntireRow.Delete%0A%20%20%20%20Loop%0A%20%20%20%20Rows(%221%3A1%22).Insert%20Shift%3A%3DxlDown%0A%20%20%20%20Range(%22A1%22)%20%3D%20%22Division%22%0A%20%20%20%20Range(%22B1%22)%20%3D%20%22Category%22%0A%20%20%20%20Range(%22C1%22)%20%3D%20%22Jan%22%0A%20%20%20%20Range(%22D1%22)%20%3D%20%22Feb%22%0A%20%20%20%20Range(%22E1%22)%20%3D%20%22Mar%22%0A%20%20%20%20Range(%22F1%22)%20%3D%20%22Total%20Expense%22%0AEnd%20Sub%0A%0ASub%20FormatData()%0A%20%20%20%20With%20Range(%22A1%3AF1%22)%0A%20%20%20%20%20%20%20%20With%20.Interior%0A%20%20%20%20%20%20%20%20%20%20%20%20.Pattern%20%3D%20xlSolid%0A%20%20%20%20%20%20%20%20%20%20%20%20.PatternColorIndex%20%3D%20xlAutomatic%0A%20%20%20%20%20%20%20%20%20%20%20%20.ThemeColor%20%3D%20xlThemeColorAccent1%0A%20%20%20%20%20%20%20%20%20%20%20%20.TintAndShade%20%3D%20-0.249977111117893%0A%20%20%20%20%20%20%20%20%20%20%20%20.PatternTintAndShade%20%3D%200%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20With%20.Font%0A%20%20%20%20%20%20%20%20%20%20%20%20.ThemeColor%20%3D%20xlThemeColorDark1%0A%20%20%20%20%20%20%20%20%20%20%20%20.TintAndShade%20%3D%200%0A%20%20%20%20%20%20%20%20%20%20%20%20.Bold%20%3D%20True%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20%20%20%20%20.Borders.LineStyle%20%3D%20xlNone%0A%20%20%20%20%20%20%20%20With%20.Borders(xlEdgeBottom)%0A%20%20%20%20%20%20%20%20%20%20%20%20.LineStyle%20%3D%20xlContinuous%0A%20%20%20%20%20%20%20%20%20%20%20%20.ColorIndex%20%3D%200%0A%20%20%20%20%20%20%20%20%20%20%20%20.TintAndShade%20%3D%200%0A%20%20%20%20%20%20%20%20%20%20%20%20.Weight%20%3D%20xlMedium%0A%20%20%20%20%20%20%20%20End%20With%0A%20%20%20%20End%20With%0A%20%20%20%20Range(Range(%22C2%22)%2C%20Range(%22C2%22).End(xlToRight).End(xlDown)).Style%20%3D%20%22Currency%22%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2084089%22%20slang%3D%22en-US%22%3ERe%3A%20Multiple%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2084089%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F127945%22%20target%3D%22_blank%22%3E%40Hans%20Vogelaar%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%3CP%3EThank%20you%20for%20the%20reply%20sir.%20But%20its%20not%20working.%20And%20as%20the%20header%20increases%20%2C%20the%20total%20becomes%20double.%3C%2FP%3E%3CP%3EI%20have%20sent%20my%20excel%20file%3C%2FP%3E%3CP%3E%26nbsp%3B%3C%2FP%3E%3C%2FLINGO-BODY%3E%3CLINGO-SUB%20id%3D%22lingo-sub-2084373%22%20slang%3D%22en-US%22%3ERe%3A%20Multiple%20headers%3C%2FLINGO-SUB%3E%3CLINGO-BODY%20id%3D%22lingo-body-2084373%22%20slang%3D%22en-US%22%3E%3CP%3E%3CA%20href%3D%22https%3A%2F%2Ftechcommunity.microsoft.com%2Ft5%2Fuser%2Fviewprofilepage%2Fuser-id%2F811137%22%20target%3D%22_blank%22%3E%40Zan_Hanifee%3C%2FA%3E%26nbsp%3B%3C%2FP%3E%0A%3CP%3EYou%20didn't%20even%20bother%20replacing%20the%20AddHeaders%20and%20FormatData%20macros%20with%20the%20macros%20that%20I%20posted...%3C%2FP%3E%0A%3CP%3EDo%20that%20now%2C%20and%20also%20change%20the%20AutoSum%20macro%20to%3C%2FP%3E%0A%3CP%3E%26nbsp%3B%3C%2FP%3E%0A%3CPRE%20class%3D%22lia-code-sample%20language-visual%22%3E%3CCODE%3EPublic%20Sub%20AutoSum()%0A%20%20%20%20Dim%20lastRow%20As%20Long%0A%20%20%20%20lastRow%20%3D%20Range(%22F%22%20%26amp%3B%20Rows.Count).End(xlUp).Row%0A%20%20%20%20Do%20While%20Range(%22F%22%20%26amp%3B%20lastRow).Formula%20Like%20%22%3DSUM*%22%0A%20%20%20%20%20%20%20%20Range(%22F%22%20%26amp%3B%20lastRow).Clear%0A%20%20%20%20%20%20%20%20lastRow%20%3D%20lastRow%20-%201%0A%20%20%20%20Loop%0A%20%20%20%20With%20Range(%22F%22%20%26amp%3B%20lastRow%20%2B%201)%0A%20%20%20%20%20%20%20%20.Formula%20%3D%20%22%3DSUM(F2%3AF%22%20%26amp%3B%20lastRow%20%26amp%3B%20%22)%22%0A%20%20%20%20%20%20%20%20.Font.Bold%20%3D%20True%0A%20%20%20%20End%20With%0AEnd%20Sub%3C%2FCODE%3E%3C%2FPRE%3E%3C%2FLINGO-BODY%3E
Contributor

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 - 

 

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

 

or

 

You can open this file 

 

 

Waiting for your reply...???

9 Replies

@Zan_Hanifee 

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

 

@Zan_Hanifee 

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

@Zan_Hanifee 

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? 

@Zan_Hanifee 

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.