Forum Discussion

Excel's avatar
Excel
Iron Contributor
Jan 21, 2021

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 - 

 

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

 

or

 

You can open this file 

 

 

Waiting for your reply...???

Macros and VBA

9 Replies

  • HansVogelaar's avatar
    HansVogelaar
    MVP
    Jan 21, 2021

    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
    • Excel's avatar
      Excel
      Iron Contributor
      Jan 21, 2021

      HansVogelaar 

      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

       

      • HansVogelaar's avatar
        HansVogelaar
        MVP
        Jan 21, 2021

        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