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
) 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
Enjoy...
