diff --git a/src/code/Chart_Processing.bas b/src/code/Chart_Processing.bas index c6019d6..da2acd5 100644 --- a/src/code/Chart_Processing.bas +++ b/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 diff --git a/src/code/Testing.bas b/src/code/Testing.bas index bbeeaea..309c564 100644 --- a/src/code/Testing.bas +++ b/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,11 +84,11 @@ 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 @@ -52,6 +96,12 @@ Public Sub ComputeDistanceMatrix() 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 diff --git a/src/code/form_newCommands.frm b/src/code/form_newCommands.frm index 6811023..f9ab8f7 100644 --- a/src/code/form_newCommands.frm +++ b/src/code/form_newCommands.frm @@ -1,11 +1,12 @@ 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" @@ -13,6 +14,7 @@ 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 diff --git a/src/code/form_newCommands.frx b/src/code/form_newCommands.frx index dcb2fc8..1b966ac 100644 Binary files a/src/code/form_newCommands.frx and b/src/code/form_newCommands.frx differ