add'l charting code, changes to distance

This adds a couple more charting functions and improves the distance
matrix calculation.

src/code/Chart_Processing.bas

@@ -8,6 +8,57 @@ Attribute VB_Name = "Chart_Processing"
 
 Option Explicit
 
+Public Sub Chart_CreateChartWithSeriesForEachColumn()
+'will create a chart that includes a series with no x value for each column
+
+    Dim rng_data As Range
+    Set rng_data = GetInputOrSelection("Select chart data")
+
+    'create a chart
+    Dim cht_obj As ChartObject
+    Set cht_obj = ActiveSheet.ChartObjects.Add(0, 0, 300, 300)
+
+    cht_obj.Chart.ChartType = xlXYScatter
+
+    Dim rng_col As Range
+    For Each rng_col In rng_data.Columns
+
+        Dim rng_chart As Range
+        Set rng_chart = RangeEnd(rng_col.Cells(1, 1), xlDown)
+
+        Dim b_ser As New bUTLChartSeries
+        Set b_ser.Values = rng_chart
+
+        b_ser.AddSeriesToChart cht_obj.Chart
+    Next
+
+End Sub
+
+Public Sub Chart_CopyToSheet()
+
+    Dim cht_obj As ChartObject
+
+    Dim obj_all As Object
+    Set obj_all = Selection
+
+    Dim msg_newSheet As VbMsgBoxResult
+    msg_newSheet = MsgBox("New sheet?", vbYesNo, "New sheet?")
+
+    Dim sht_out As Worksheet
+    If msg_newSheet = vbYes Then
+        Set sht_out = Worksheets.Add()
+    Else
+        Set sht_out = Application.InputBox("Pick a cell on a sheet", "Pick sheet", Type:=8).Parent
+    End If
+
+    For Each cht_obj In Chart_GetObjectsFromObject(obj_all)
+        cht_obj.Copy
+
+        sht_out.Paste
+    Next
+
+    sht_out.Activate
+End Sub
 
 Sub Chart_SortSeriesByName()
 'this will sort series by names

src/code/Testing.bas

@@ -9,7 +9,7 @@ Public Sub ComputeDistanceMatrix()
 
     'Dim rng_ID As Range
     'Set rng_ID = Application.InputBox("Select ID data", "ID", Type:=8)
-    
+
     'turning off updates makes a huge difference here... could also use array for output
     Application.ScreenUpdating = False
     Application.Calculation = xlCalculationManual
@@ -19,12 +19,56 @@ Public Sub ComputeDistanceMatrix()
     Dim wkbk As Workbook
     Set wkbk = Workbooks.Add
 
+    Dim sht_out As Worksheet
+    Set sht_out = wkbk.Sheets(1)
+    sht_out.name = "scaled data"
+
+    'copy data over to standardize
+    rng_input.Copy wkbk.Sheets(1).Range("A1")
+
+    'go to edge of data, add a column, add STANDARDIZE, copy paste values, delete
+
+    Dim rng_data As Range
+    Set rng_data = sht_out.Range("A1").CurrentRegion
+
+    Dim rng_col As Range
+    For Each rng_col In rng_data.Columns
+
+        'edge cell
+        Dim rng_edge As Range
+        Set rng_edge = sht_out.Cells(1, sht_out.Columns.count).End(xlToLeft).Offset(, 1)
+
+        'do a normal dist standardization
+        '=STANDARDIZE(A1,AVERAGE(A:A),STDEV.S(A:A))
+
+        rng_edge.Formula = "=IFERROR(STANDARDIZE(" & rng_col.Cells(1, 1).Address(False, False) & ",AVERAGE(" & _
+            rng_col.Address & "),STDEV.S(" & rng_col.Address & ")),0)"
+
+        'do a simple value over average to detect differences
+        rng_edge.Formula = "=IFERROR(" & rng_col.Cells(1, 1).Address(False, False) & "/AVERAGE(" & _
+            rng_col.Address & "),1)"
+
+        'fill that down
+        Range(rng_edge, rng_edge.Offset(, -1).End(xlDown).Offset(, 1)).FillDown
+
+    Next
+
+    Application.Calculate
+    sht_out.UsedRange.Value = sht_out.UsedRange.Value
+    rng_data.EntireColumn.Delete
+
+    Dim sht_dist As Worksheet
+    Set sht_dist = wkbk.Worksheets.Add()
+    sht_dist.name = "distances"
+
     Dim rng_out As Range
-    Set rng_out = wkbk.Sheets(1).Range("A1")
+    Set rng_out = sht_dist.Range("A1")
 
     'loop through each row with each other row
     Dim rng_row1 As Range
     Dim rng_row2 As Range
+
+    Set rng_input = sht_out.Range("A1").CurrentRegion
 
     For Each rng_row1 In rng_input.Rows
         For Each rng_row2 In rng_input.Rows
@@ -40,18 +84,24 @@ Public Sub ComputeDistanceMatrix()
 
             'take the sqrt of that value and output
             rng_out.Value = dbl_dist_sq ^ 0.5
-            
+
             'get to next column for output
             Set rng_out = rng_out.Offset(, 1)
         Next
-        
+
         'drop down a row and go back to left edge
         Set rng_out = rng_out.Offset(1).End(xlToLeft)
     Next
 
     Application.EnableEvents = True
     Application.Calculation = xlCalculationAutomatic
     Application.ScreenUpdating = True
+
+    sht_dist.UsedRange.NumberFormat = "0.00"
+    sht_dist.UsedRange.EntireColumn.AutoFit
+
+    'do the coloring
+    Formatting_AddCondFormat sht_dist.UsedRange
 
 End Sub
 
@@ -61,20 +111,23 @@ Sub RemoveAllLegends()
 
     For Each cht_obj In Chart_GetObjectsFromObject(Selection)
         cht_obj.Chart.HasLegend = False
-        cht_obj.Chart.HasTitle = False
+        cht_obj.Chart.HasTitle = True
+
+        cht_obj.Chart.SeriesCollection(1).MarkerSize = 4
     Next
 
 End Sub
 
 Sub ApplyFormattingToEachColumn()
-'
-' Macro1 Macro
-'
-
-'
     Dim rng As Range
     For Each rng In Selection.Columns
 
+        Formatting_AddCondFormat rng
+    Next
+End Sub
+
+Private Sub Formatting_AddCondFormat(ByVal rng As Range)
+
         rng.FormatConditions.AddColorScale ColorScaleType:=3
         rng.FormatConditions(rng.FormatConditions.count).SetFirstPriority
         rng.FormatConditions(1).ColorScaleCriteria(1).Type = _
@@ -96,9 +149,10 @@ Sub ApplyFormattingToEachColumn()
             .Color = 8109667
             .TintAndShade = 0
         End With
-    Next
 End Sub
 
+
+
 '---------------------------------------------------------------------------------------
 ' Procedure : TraceDependentsForAll
 ' Author    : @byronwall

src/code/form_newCommands.frm

@@ -1,18 +1,20 @@
 VERSION 5.00
 Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} form_newCommands 
    Caption         =   "Additional Features"
-   ClientHeight    =   7770
+   ClientHeight    =   8460
    ClientLeft      =   45
    ClientTop       =   435
    ClientWidth     =   6585
    OleObjectBlob   =   "form_newCommands.frx":0000
+   ShowModal       =   0   'False
    StartUpPosition =   1  'CenterOwner
 End
 Attribute VB_Name = "form_newCommands"
 Attribute VB_GlobalNameSpace = False
 Attribute VB_Creatable = False
 Attribute VB_PredeclaredId = True
 Attribute VB_Exposed = False
+
 Option Explicit
 
 '---------------------------------------------------------------------------------------
@@ -92,3 +94,11 @@ End Sub
 Private Sub CommandButton30_Click()
     ApplyFormattingToEachColumn
 End Sub
+
+Private Sub CommandButton31_Click()
+    ComputeDistanceMatrix
+End Sub
+
+Private Sub CommandButton32_Click()
+    Chart_CreateChartWithSeriesForEachColumn
+End Sub