"Match" sheet code-behind ------------------------------------------------------------------------ Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Call DoThings(ActiveCell.Column, ActiveCell.Row) End Sub "AddToDataLists" module ------------------------------------------------------------------------ Option Explicit Public Sub Add_PlaceToDatalists() Dim i As Long Dim j As Long Dim temp1 As String Dim temp2 As Double Dim endMarker As Double Dim sortBoolean As Boolean Dim sortVector() As Variant j = 0 ReDim sortVector(1 To MetaDatas.Item(1).CountNotEmpty(), 1 To 2) For i = 1 To DataLists.Count If DataLists.Item(i).NotEmpty = True Then j = j + 1 sortVector(j, 1) = DataLists.Item(i).Entry sortVector(j, 2) = DataLists.Item(i).Sequence End If Next i endMarker = MetaDatas.Item(1).CountNotEmpty() - 1 sortBoolean = True Do While sortBoolean = True sortBoolean = False For i = 1 To endMarker If sortVector(i, 1) > sortVector(i + 1, 1) Then temp1 = sortVector(i, 1) temp2 = sortVector(i, 2) sortVector(i, 1) = sortVector(i + 1, 1) sortVector(i, 2) = sortVector(i + 1, 2) sortVector(i + 1, 1) = temp1 sortVector(i + 1, 2) = temp2 sortBoolean = True End If Next i endMarker = endMarker - 1 Loop For i = 1 To MetaDatas.Item(1).CountNotEmpty() DataLists.Item(sortVector(i, 2)).Place = i Next i End Sub Public Sub Add_StandardToDatalists() Dim i As Long Dim j As Long Dim temp1 As String Dim temp2 As Double Dim endMarker As Double Dim sortBoolean As Boolean Dim sortVector() As Variant j = 0 ReDim sortVector(1 To MetaDatas.Item(1).CountNotEmpty(), 1 To 3) For i = 1 To DataLists.Count If DataLists.Item(i).NotEmpty = True Then j = j + 1 sortVector(j, 1) = DataLists.Item(i).Entry sortVector(j, 2) = DataLists.Item(i).Sequence sortVector(j, 3) = 0 End If Next i endMarker = MetaDatas.Item(1).CountNotEmpty() - 1 sortBoolean = True Do While sortBoolean = True sortBoolean = False For i = 1 To endMarker If sortVector(i, 1) > sortVector(i + 1, 1) Then temp1 = sortVector(i, 1) temp2 = sortVector(i, 2) sortVector(i, 1) = sortVector(i + 1, 1) sortVector(i, 2) = sortVector(i + 1, 2) sortVector(i + 1, 1) = temp1 sortVector(i + 1, 2) = temp2 sortBoolean = True End If Next i endMarker = endMarker - 1 Loop j = 1 sortVector(1, 3) = j For i = 1 To MetaDatas.Item(1).CountNotEmpty() - 1 If sortVector(i, 1) = sortVector(i + 1, 1) Then sortVector(i + 1, 3) = j Else j = j + 1 sortVector(i + 1, 3) = j End If Next i For i = 1 To MetaDatas.Item(1).CountNotEmpty() DataLists.Item(sortVector(i, 2)).Grouping = sortVector(i, 3) Next i End Sub Public Sub Add_LastChildToDatalists() Dim i As Long Dim j As Long Dim hitVector() As Variant ReDim hitVector(1 To MetaDatas.Item(1).CountDifferent(), 1 To 2) For i = 1 To MetaDatas.Item(1).CountDifferent() For j = 1 To DataLists.Count If DataLists.Item(j).Grouping = i Then hitVector(i, 1) = j hitVector(i, 2) = i End If Next j Next i For i = 1 To MetaDatas.Item(1).CountDifferent() DataLists.Item(hitVector(i, 1)).LastChild = hitVector(i, 2) DataLists.Item(hitVector(i, 1)).NewEntry = DataLists.Item(hitVector(i, 1)).Entry Next i End Sub Public Sub Add_KeeperToDatalists() Dim i As Long Dim j As Long Worksheets("Keep").Activate For i = 1 To MetaDatas.Item(1).CountDifferent() If Cells(i, 7).Value = "Sant" Then For j = 1 To DataLists.Count If DataLists.Item(j).LastChild = i Then DataLists.Item(j).Keeper = True DataLists.Item(j).NewEntry = Cells(i, 8).Value End If Next j End If Next i End Sub "Display" module ------------------------------------------------------------------------ Option Explicit Public Sub Display_Exploration() Dim i As Long Dim j As Long Worksheets("Keep").Activate For i = 1 To MetaDatas.Item(1).CountDifferent() For j = 1 To DataLists.Count If DataLists.Item(j).LastChild = i Then Cells(i, 1).Value = DataLists.Item(j).Sequence Cells(i, 2).Value = DataLists.Item(j).Entry Cells(i, 3).Value = DataLists.Item(j).NotEmpty Cells(i, 4).Value = DataLists.Item(j).Place Cells(i, 5).Value = DataLists.Item(j).Grouping Cells(i, 6).Value = DataLists.Item(j).LastChild Cells(i, 7).Value = DataLists.Item(j).Keeper Cells(i, 8).Value = DataLists.Item(j).NewEntry Cells(i, 9).Value = DataLists.Item(j).Category End If Next j Next i End Sub Public Sub Display_DataPoints() Dim i As Long Worksheets("Match").Activate For i = 1 To DataPoints.Count With Cells(DataPoints.Item(i).RowNumber, DataPoints.Item(i).ColumnNumber) .Value = DataPoints.Item(i).Content .Font.Color = States.Item(DataPoints.Item(i).PurposeState).ColorCode .Font.Bold = States.Item(DataPoints.Item(i).PurposeState).IsBold End With Next i End Sub Public Function Display_DataLists() Dim i As Long Worksheets("Explore").Activate For i = 1 To DataLists.Count Cells(i, 1).Value = DataLists.Item(i).Sequence Cells(i, 2).Value = DataLists.Item(i).Entry Cells(i, 3).Value = DataLists.Item(i).NotEmpty Cells(i, 4).Value = DataLists.Item(i).Place Cells(i, 5).Value = DataLists.Item(i).Grouping Cells(i, 6).Value = DataLists.Item(i).LastChild Cells(i, 7).Value = DataLists.Item(i).Keeper Cells(i, 8).Value = DataLists.Item(i).NewEntry Cells(i, 9).Value = DataLists.Item(i).Category Next i End Function Public Function Display_Results() Dim i As Long Worksheets("Output").Activate For i = 1 To DataLists.Count Cells(i, 1).Value = DataLists.Item(i).Sequence Cells(i, 2).Value = DataLists.Item(i).Entry Cells(i, 3).Value = DataLists.Item(i).Category Next i End Function Public Sub Display_Demo() Dim i As Long Dim vDemo(1 To 29) As String Worksheets("Input").Activate vDemo(1) = "" vDemo(2) = "nor" vDemo(3) = "" vDemo(4) = "" vDemo(5) = "norflox" vDemo(6) = "" vDemo(7) = "" vDemo(8) = "cip" vDemo(9) = "cipr" vDemo(10) = "" vDemo(11) = "" vDemo(12) = "cipro" vDemo(13) = "" vDemo(14) = "" vDemo(15) = "ciproflox" vDemo(16) = "" vDemo(17) = "cipr" vDemo(18) = "" vDemo(19) = "norfloxa" vDemo(20) = "" vDemo(21) = "noorflox" vDemo(22) = "cipro" vDemo(23) = "" vDemo(24) = "" vDemo(25) = "ciproflox" vDemo(26) = "nor" vDemo(27) = "" vDemo(28) = "" vDemo(29) = "CCCDDD" For i = LBound(vDemo) To UBound(vDemo) Cells(i, 1).Value = vDemo(i) Next i End Sub "Main" module ------------------------------------------------------------------------ Option Explicit Public DataPoints As Collection Public Sub UpToKeeper() Call Create_Worksheets Call Clear_Worksheets Call Display_Demo Call Populate_Datalists Call Populate_Metadatas Call Add_PlaceToDatalists Call Add_StandardToDatalists Call Add_LastChildToDatalists Call Populate_Definitions Call Populate_States Call Display_DataLists Call Display_Exploration End Sub Public Sub UpToMatcher() Dim i As Long Dim j As Long Dim k As Long Dim l As Long Call Add_KeeperToDatalists Call MetaDatas.Item(1).EnumerateKeepers Call Display_DataLists Set DataPoints = New Collection Dim dp As Datapoint For i = 1 To MetaDatas.Item(1).CountDifferent() + 1 For j = 1 To MetaDatas.Item(1).CountKeepers() + 1 Set dp = New Datapoint DataPoints.Add dp Call DataPoints.Item(DataPoints.Count).Set_DataPoint(DataPoints.Count, i, j, "*", Definitions.Item(1).GeneralOff) Next j Next i Call DataPoints.Item(1).Adjust_DataPoint("", Definitions.Item(1).OrigoOff) For i = 1 To MetaDatas.Item(1).CountKeepers() For j = 1 To DataLists.Count If DataLists.Item(j).KeeperNumber = i Then For k = 1 To DataPoints.Count If DataPoints.Item(k).ColumnNumber = i + 1 And DataPoints.Item(k).RowNumber = 1 Then Call DataPoints.Item(k).Adjust_DataPoint(DataLists.Item(j).NewEntry, Definitions.Item(1).HorizontalHeaderOff) End If Next k End If Next j Next i For i = 1 To MetaDatas.Item(1).CountDifferent() For j = 1 To DataLists.Count If DataLists.Item(j).LastChild = i Then For k = 1 To DataPoints.Count If DataPoints.Item(k).ColumnNumber = 1 And DataPoints.Item(k).RowNumber = i + 1 Then Call DataPoints.Item(k).Adjust_DataPoint(DataLists.Item(j).Entry, Definitions.Item(1).VerticalHeaderOff) End If Next k For l = 1 To MetaDatas.Item(1).CountKeepers() For k = 1 To DataPoints.Count If DataPoints.Item(k).ColumnNumber = l + 1 And DataPoints.Item(k).RowNumber = i + 1 Then Call DataPoints.Item(k).Adjust_DataPoint(DataLists.Item(j).Entry, Definitions.Item(1).GeneralOff) End If Next k Next l End If Next j Next i Call Display_DataPoints End Sub Public Sub Populate_Results() Dim i As Long Dim j As Long Dim k As Long For i = 1 To DataPoints.Count For j = 1 To DataLists.Count If DataPoints.Item(i).PurposeState = Definitions.Item(1).GeneralOn And DataPoints.Item(i).Content = DataLists.Item(j).Entry Then For k = 1 To DataPoints.Count If DataPoints.Item(k).PurposeState = Definitions.Item(1).HorizontalHeaderOn And DataPoints.Item(k).ColumnNumber = DataPoints.Item(i).ColumnNumber Then DataLists.Item(j).Category = DataPoints.Item(k).Content End If Next k End If Next j Next i Call Display_DataLists Call Display_Results End Sub Public Sub DoThings(ByVal value1 As Double, ByVal value2 As Double) Dim i As Long Dim j As Long Dim k As Long Dim l As Long Dim hit As Boolean Dim index As Double Dim nowState As String index = 0 nowState = "" For i = 1 To DataPoints.Count If DataPoints.Item(i).ColumnNumber = value1 And DataPoints.Item(i).RowNumber = value2 Then index = i End If Next i If index > 0 Then If DataPoints.Item(index).PurposeState = Definitions.Item(1).GeneralOff Then nowState = "Off" End If If DataPoints.Item(index).PurposeState = Definitions.Item(1).GeneralOn Then nowState = "On" End If If nowState <> "" Then Select Case nowState Case "Off" For i = 1 To DataPoints.Count If DataPoints.Item(i).PurposeState = Definitions.Item(1).GeneralOn And DataPoints.Item(i).RowNumber = DataPoints.Item(index).RowNumber Then DataPoints.Item(i).PurposeState = Definitions.Item(1).GeneralOff End If Next i DataPoints.Item(index).PurposeState = Definitions.Item(1).GeneralOn Case "On" DataPoints.Item(index).PurposeState = Definitions.Item(1).GeneralOff End Select End If End If For i = 1 To DataPoints.Count If States.Item(DataPoints.Item(i).PurposeState).Purpose = Definitions.Item(1).HorizontalHeader Then DataPoints.Item(i).PurposeState = Definitions.Item(1).HorizontalHeaderOff ElseIf States.Item(DataPoints.Item(i).PurposeState).Purpose = Definitions.Item(1).VerticalHeader Then DataPoints.Item(i).PurposeState = Definitions.Item(1).VerticalHeaderOff End If Next i For i = 2 To MetaDatas.Item(1).CountDifferent() + 1 For j = 2 To MetaDatas.Item(1).CountKeepers() + 1 For k = 1 To DataPoints.Count If DataPoints.Item(k).RowNumber = i And DataPoints.Item(k).ColumnNumber = j And DataPoints.Item(k).PurposeState = Definitions.Item(1).GeneralOn Then For l = 1 To DataPoints.Count If States.Item(DataPoints.Item(l).PurposeState).Purpose = Definitions.Item(1).HorizontalHeader And DataPoints.Item(l).ColumnNumber = j Then DataPoints.Item(l).PurposeState = Definitions.Item(1).HorizontalHeaderOn ElseIf States.Item(DataPoints.Item(l).PurposeState).Purpose = Definitions.Item(1).VerticalHeader And DataPoints.Item(l).RowNumber = i Then DataPoints.Item(l).PurposeState = Definitions.Item(1).VerticalHeaderOn End If Next l End If Next k Next j Next i hit = False For i = 1 To DataPoints.Count If States.Item(DataPoints.Item(i).PurposeState).PurposeState = Definitions.Item(1).HorizontalHeaderOff Then hit = True ElseIf States.Item(DataPoints.Item(i).PurposeState).PurposeState = Definitions.Item(1).VerticalHeaderOff Then hit = True End If Next i If hit = False Then DataPoints.Item(1).PurposeState = Definitions.Item(1).OrigoOn DataPoints.Item(1).Content = "MATCH" Else DataPoints.Item(1).PurposeState = Definitions.Item(1).OrigoOff DataPoints.Item(1).Content = "" End If Call Display_DataPoints End Sub "Populate" module ------------------------------------------------------------------------ Option Explicit Public DataLists As Collection Public MetaDatas As Collection Public Definitions As Collection Public States As Dictionary Public Sub Populate_Datalists() Dim i As Long Dim d As Datalist Set DataLists = New Collection Worksheets("Input").Activate i = 0 Do i = i + 1 Set d = New Datalist DataLists.Add d DataLists.Item(i).Sequence = i DataLists.Item(i).Entry = Cells(i, 1).Value DataLists.Item(i).IsNotEmpty Loop While DataLists.Item(i).Entry <> "CCCDDD" DataLists.Remove (i) End Sub Public Sub Populate_Metadatas() Set MetaDatas = New Collection Dim m As MetaData Set m = New MetaData MetaDatas.Add m End Sub Public Sub Populate_Definitions() Set Definitions = New Collection Dim d As Definition Set d = New Definition Definitions.Add d End Sub Public Sub Populate_States() Set States = New Dictionary Dim s1 As State Set s1 = New State States.Add Definitions.Item(1).OrigoOn, s1 Dim s2 As State Set s2 = New State States.Add Definitions.Item(1).OrigoOff, s2 Dim s3 As State Set s3 = New State States.Add Definitions.Item(1).HorizontalHeaderOn, s3 Dim s4 As State Set s4 = New State States.Add Definitions.Item(1).HorizontalHeaderOff, s4 Dim s5 As State Set s5 = New State States.Add Definitions.Item(1).VerticalHeaderOn, s5 Dim s6 As State Set s6 = New State States.Add Definitions.Item(1).VerticalHeaderOff, s6 Dim s7 As State Set s7 = New State States.Add Definitions.Item(1).GeneralOn, s7 Dim s8 As State Set s8 = New State States.Add Definitions.Item(1).GeneralOff, s8 With States .Item(Definitions.Item(1).OrigoOn).Transform_OrigoOn .Item(Definitions.Item(1).OrigoOff).Transform_OrigoOff .Item(Definitions.Item(1).HorizontalHeaderOn).Transform_HorizontalHeaderOn .Item(Definitions.Item(1).HorizontalHeaderOff).Transform_HorizontalHeaderOff .Item(Definitions.Item(1).VerticalHeaderOn).Transform_VerticalHeaderOn .Item(Definitions.Item(1).VerticalHeaderOff).Transform_VerticalHeaderOff .Item(Definitions.Item(1).GeneralOn).Transform_GeneralOn .Item(Definitions.Item(1).GeneralOff).Transform_GeneralOff End With End Sub "PrepareSheets" module ------------------------------------------------------------------------ Option Explicit Public Sub Create_Worksheets() Dim i As Long Dim ws As Worksheet Dim wsNames(1 To 5) As String wsNames(1) = "Input" wsNames(2) = "Explore" wsNames(3) = "Keep" wsNames(4) = "Match" wsNames(5) = "Output" For i = LBound(wsNames) To UBound(wsNames) If Check_If_Worksheet_Exists(wsNames(i)) = False Then Set ws = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ws.Name = wsNames(i) End If Next i End Sub Public Sub Clear_Worksheets() Dim i As Long Dim ws As Worksheet Dim wsNames(1 To 5) As String wsNames(1) = "Input" wsNames(2) = "Explore" wsNames(3) = "Keep" wsNames(4) = "Match" wsNames(5) = "Output" For i = LBound(wsNames) To UBound(wsNames) If Check_If_Worksheet_Exists(wsNames(i)) = True Then Worksheets(wsNames(i)).Cells.Clear End If Next i End Sub Public Function Check_If_Worksheet_Exists(ByVal value1 As String) As Boolean Dim ws As Worksheet Dim WorksheetExists As Boolean WorksheetExists = False For Each ws In Worksheets If ws.Name = value1 Then WorksheetExists = True End If Next ws Check_If_Worksheet_Exists = WorksheetExists End Function "DataList" class module ------------------------------------------------------------------------ Option Explicit Public Sequence As Double Public Entry As String Public NotEmpty As Boolean Public Place As Double Public Grouping As Double Public LastChild As Double Public Keeper As Boolean Public KeeperNumber As Double Public NewEntry As String Public Category As String Private Sub Class_Initialize() Me.Sequence = 0 Me.Entry = "" Me.NotEmpty = False Me.Place = 0 Me.Grouping = 0 Me.LastChild = 0 Me.Keeper = False Me.KeeperNumber = 0 Me.NewEntry = "" Me.Category = "" End Sub Public Sub IsNotEmpty() If Me.Entry <> "" Then Me.NotEmpty = True End If End Sub "DataPoint" class module ------------------------------------------------------------------------ Option Explicit Public index As Double Public ColumnNumber As Long Public RowNumber As Long Public Content As String Public PurposeState As String Private Sub Class_Initialize() Me.index = 0 Me.ColumnNumber = 0 Me.RowNumber = 0 Me.Content = Definitions.Item(1).Content Me.PurposeState = Definitions.Item(1).GeneralOff End Sub Public Sub Set_DataPoint(ByVal value1 As Double, ByVal value2 As Long, ByVal value3 As Long, ByVal value4 As String, ByVal value5 As String) Me.index = value1 Me.RowNumber = value2 Me.ColumnNumber = value3 Me.Content = value4 Me.PurposeState = value5 End Sub Public Sub Adjust_DataPoint(ByVal value1 As String, ByVal value2 As String) Me.Content = value1 Me.PurposeState = value2 End Sub "Definition" class module ------------------------------------------------------------------------ Option Explicit Public RedCode As Double Public BlueCode As Double Public GreenCode As Double Public GrayCode As Double Public GoldCode As Double Public BlackCode As Double Public RedName As String Public BlueName As String Public GreenName As String Public GrayName As String Public GoldName As String Public BlackName As String Public Origo As String Public HorizontalHeader As String Public VerticalHeader As String Public General As String Public StateOn As String Public StateOff As String Public OrigoOn As String Public OrigoOff As String Public HorizontalHeaderOn As String Public HorizontalHeaderOff As String Public VerticalHeaderOn As String Public VerticalHeaderOff As String Public GeneralOn As String Public GeneralOff As String Public Content As String Private Sub Class_Initialize() Me.RedCode = 238 Me.BlueCode = 16741960 Me.GreenCode = 1343536 Me.GrayCode = 14408667 Me.GoldCode = 962030 Me.BlackCode = 0 Me.RedName = "Red" Me.BlueName = "Blue" Me.GreenName = "Green" Me.GrayName = "Gray" Me.GoldName = "Gold" Me.BlackName = "Black" Me.Origo = "Origo" Me.HorizontalHeader = "HorizontalHeader" Me.VerticalHeader = "VerticalHeader" Me.General = "General" Me.StateOn = "On" Me.StateOff = "Off" Me.OrigoOn = "OrigoOn" Me.OrigoOff = "OrigoOffName" Me.HorizontalHeaderOn = "HorizontalHeaderOn" Me.HorizontalHeaderOff = "HorizontalHeaderOff" Me.VerticalHeaderOn = "VerticalHeaderOn" Me.VerticalHeaderOff = "VerticalHeaderOff" Me.GeneralOn = "GeneralOn" Me.GeneralOff = "GeneralOff" Me.Content = "*" End Sub "MetaData" class module ------------------------------------------------------------------------ Option Explicit Public Function CountNotEmpty() As Double Dim i As Long Dim j As Double j = 0 For i = 1 To DataLists.Count If DataLists.Item(i).NotEmpty = True Then j = j + 1 End If Next i CountNotEmpty = j End Function Public Function CountDifferent() As Double Dim i As Long Dim j As Double j = 0 For i = 1 To DataLists.Count If DataLists.Item(i).Grouping > j Then j = DataLists.Item(i).Grouping End If Next i CountDifferent = j End Function Public Function CountKeepers() As Double Dim i As Long Dim j As Double j = 0 For i = 1 To DataLists.Count If DataLists.Item(i).Keeper = True Then j = j + 1 End If Next i CountKeepers = j End Function Public Sub EnumerateKeepers() Dim i As Long Dim j As Double Dim k As Double k = 0 For i = 1 To Me.CountDifferent() For j = 1 To DataLists.Count If DataLists.Item(j).LastChild = i And DataLists.Item(j).Keeper = True Then k = k + 1 DataLists.Item(j).KeeperNumber = k End If Next j Next i End Sub "State" class module ------------------------------------------------------------------------ Option Explicit Public IsBold As Boolean Public ColorCode As Double Public ColorName As String Public Purpose As String Public State As String Public PurposeState As String Public Content As String Private Sub Class_Initialize() Me.IsBold = False Me.ColorCode = Definitions.Item(1).GrayCode Me.ColorName = Definitions.Item(1).GrayName Me.Purpose = Definitions.Item(1).General Me.State = Definitions.Item(1).StateOff Me.PurposeState = Definitions.Item(1).GeneralOff Me.Content = Definitions.Item(1).Content End Sub Public Sub Transform_OrigoOn() Me.IsBold = False Me.ColorCode = Definitions.Item(1).GoldCode Me.ColorName = Definitions.Item(1).GoldName Me.Purpose = Definitions.Item(1).Origo Me.State = Definitions.Item(1).StateOn Me.PurposeState = Definitions.Item(1).OrigoOn End Sub Public Sub Transform_OrigoOff() Me.IsBold = False Me.ColorCode = Definitions.Item(1).GoldCode Me.ColorName = Definitions.Item(1).GoldName Me.Purpose = Definitions.Item(1).Origo Me.State = Definitions.Item(1).StateOff Me.PurposeState = Definitions.Item(1).OrigoOff End Sub Public Sub Transform_HorizontalHeaderOn() Me.IsBold = False Me.ColorCode = Definitions.Item(1).GreenCode Me.ColorName = Definitions.Item(1).GreenName Me.Purpose = Definitions.Item(1).HorizontalHeader Me.State = Definitions.Item(1).StateOn Me.PurposeState = Definitions.Item(1).HorizontalHeaderOn End Sub Public Sub Transform_HorizontalHeaderOff() Me.IsBold = True Me.ColorCode = Definitions.Item(1).RedCode Me.ColorName = Definitions.Item(1).RedName Me.Purpose = Definitions.Item(1).HorizontalHeader Me.State = Definitions.Item(1).StateOff Me.PurposeState = Definitions.Item(1).HorizontalHeaderOff End Sub Public Sub Transform_VerticalHeaderOn() Me.IsBold = False Me.ColorCode = Definitions.Item(1).GreenCode Me.ColorName = Definitions.Item(1).GreenName Me.Purpose = Definitions.Item(1).VerticalHeader Me.State = Definitions.Item(1).StateOn Me.PurposeState = Definitions.Item(1).VerticalHeaderOn End Sub Public Sub Transform_VerticalHeaderOff() Me.IsBold = True Me.ColorCode = Definitions.Item(1).RedCode Me.ColorName = Definitions.Item(1).RedName Me.Purpose = Definitions.Item(1).VerticalHeader Me.State = Definitions.Item(1).StateOff Me.PurposeState = Definitions.Item(1).VerticalHeaderOff End Sub Public Sub Transform_GeneralOn() Me.IsBold = False Me.ColorCode = Definitions.Item(1).BlackCode Me.ColorName = Definitions.Item(1).BlackName Me.Purpose = Definitions.Item(1).General Me.State = Definitions.Item(1).StateOn Me.PurposeState = Definitions.Item(1).GeneralOn End Sub Public Sub Transform_GeneralOff() Me.IsBold = False Me.ColorCode = Definitions.Item(1).GrayCode Me.ColorName = Definitions.Item(1).GrayName Me.Purpose = Definitions.Item(1).General Me.State = Definitions.Item(1).StateOff Me.PurposeState = Definitions.Item(1).GeneralOff End Sub