Histogram Macro with category %'s

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Histogram Macro with category %'s

Post by Rudi »

Hi,

When using a histogram, I have always been fussed with the fact that the optional % output of the histogram analysis tool is cumulative. So, as a little "pet project", I thought I'd create a macro to insert a category % into the resulting histogram table. I have tested the code and it seems to work well, all be it that the experts may find it a little primitive and the fact that I do not have full error handling in it. If you may benefit from this macro, feel free to use it and tweak it and upload your variations (or improvements :smile:) to the thread. Cheers!!!

HERE IS THE MACRO:

Code: Select all

Sub AddCatPerc()
    Dim myTableType As Integer
    Dim myHistogramTable As Range, CatCol As Range, myStartCell As Range
    Dim CatColNumCells As Integer, i As Integer
    myTableType = _
        MsgBox("Does your histogram table have a cumulative % column?", vbYesNo + vbInformation, _
        "Histogram Structure")
    If myTableType = vbYes Then
    'Code for TRUE statement
        Set myStartCell = ActiveCell
        On Error GoTo EH
        Set myHistogramTable = _
            Application.InputBox("Select a cell in the histogram table", _
                                    "Histogram Location", Type:=8)
        If Not myHistogramTable Is Nothing Then
            Set CatCol = _
                myHistogramTable.CurrentRegion.Columns(myHistogramTable.CurrentRegion.Columns.Count).Offset(0, 1)
            CatColNumCells = CatCol.Cells.Count
            'Populate cells with data
            Application.ScreenUpdating = False
            CatCol.Cells(1).Value = "Category %"
            CatCol.Cells(2).FormulaR1C1 = "=RC[-1]"
            For i = 3 To CatColNumCells
                CatCol.Cells(i).FormulaR1C1 = "=RC[-1]-R[-1]C[-1]"
            Next i
            'Format the histogram
            CatCol.Offset(0, -1).Copy
            CatCol.PasteSpecial xlPasteFormats
            CatCol.Copy
            CatCol.PasteSpecial xlPasteValues
            Application.CutCopyMode = False
            myHistogramTable.CurrentRegion.EntireColumn.AutoFit
            myStartCell.Select
            Application.ScreenUpdating = True
        Else
            MsgBox "You did not provide the correct value count " & _
                    "or you cancelled the prompt. Please try again!", vbExclamation
            Exit Sub
        End If
    Else
        Dim SourceTable As Range, SourceTableValueCount As Long
        On Error GoTo EH
        Set SourceTable = Application.InputBox("You have indicated that your histogram " & _
            "table does not contain a cumulative% column. In this event you need to " & _
            "select the source table in order to create a category%.", _
            "Select the histogram table source", Type:=8)
            If Not SourceTable Is Nothing Then
                SourceTableValueCount = SourceTable.CurrentRegion.Cells.Count
                Set myStartCell = ActiveCell
                On Error GoTo EH
                Set myHistogramTable = _
                    Application.InputBox("Select a cell in the histogram table", _
                                            "Histogram Location", Type:=8)
                Set CatCol = _
                    myHistogramTable.CurrentRegion.Columns(myHistogramTable.CurrentRegion.Columns.Count).Offset(0, 1)
                CatColNumCells = CatCol.Cells.Count
                'Populate cells with data
                Application.ScreenUpdating = False
                CatCol.Cells(1).Value = "Category %"
                For i = 2 To CatColNumCells
                    CatCol.Cells(i).FormulaR1C1 = "=RC[-1]/" & SourceTableValueCount
                Next i
                'Format the histogram
                CatCol.Offset(0, -1).Copy
                CatCol.PasteSpecial xlPasteFormats
                CatCol.Copy
                CatCol.PasteSpecial xlPasteValues
                CatCol.NumberFormat = "0.00%"
                Application.CutCopyMode = False
                myHistogramTable.CurrentRegion.EntireColumn.AutoFit
                myStartCell.Select
                Application.ScreenUpdating = True
            Else
                MsgBox "You did not provide the correct value count " & _
                        "or you cancelled the prompt. Please try again!", vbExclamation
                Exit Sub
            End If
    End If
    Exit Sub
EH:
    MsgBox "You cancelled the prompt and quit the macro. Please try again if required!", vbExclamation
End Sub
I have also attached the Excel 2007 workbook that contains a working example if you want to try it out!

Enjoy...
You do not have the required permissions to view the files attached to this post.
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.

User avatar
HansV
Administrator
Posts: 78350
Joined: 16 Jan 2010, 00:14
Status: Microsoft MVP
Location: Wageningen, The Netherlands

Re: Histogram Macro with category %'s

Post by HansV »

That works well. It might be useful to note that pivot tables have the option to display various percentages (both cumulative and not) built in.
Best wishes,
Hans

User avatar
Rudi
gamma jay
Posts: 25455
Joined: 17 Mar 2010, 17:33
Location: Cape Town

Re: Histogram Macro with category %'s

Post by Rudi »

>>> That works well. :grin: :smile:

Wow...as my "VBA mentor" :grin: that is a wonderful thing to hear!!!!
Regards,
Rudi

If your absence does not affect them, your presence didn't matter.