"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