Skip to content

Instantly share code, notes, and snippets.

@AntonGoedecke

AntonGoedecke/Kombinator Secret

Last active May 3, 2019
Embed
What would you like to do?
Attribute VB_Name = "Kombinator"
Option Explicit
Public Function GetHeaderName(Col As long) As Variant
Dim RefDat As Range
Set RefDat = ThisWorkbook.Worksheets("ReferenceData").UsedRange
Dim r As Range
Dim CurField As Variant
Dim ColCount As long
For Each r In RefDat.Rows ' Iterate over reference data table
If r.Row = 1 Then ' ignore first row that holds the column headers of the reference data row
ColCount = 0
Else
If r.Cells(1, 1).Value <> CurField Then ' Next field found
ColCount = ColCount + 1
CurField = r.Cells(1, 1).Value
End If
If ColCount = Col Then
GetHeaderName = r.Cells(1, 1).Value
Exit For
End If
End If
Next r
End Function
Public Function GetValue(Row As long, Col As long) As Variant
Dim RefDat As Range
Set RefDat = ThisWorkbook.Worksheets("ReferenceData").UsedRange
Dim r As Range
Dim CurField As Variant ' Stores the current line of reference data while iterating over it
Dim ValCount As long ' Stores the count of values that belong to the current field
Dim RowCount As long ' Stores the total row count of the result
Dim ColCount As long ' Stores the total column count of the result
Dim ValCountCol As long ' Stores the value count of the column that is requested via the col parameter
Dim RepCountCol As long ' Stores how often the values of the requested column are repeated in the result set
Dim LastVal As Boolean ' Stores if the current reference data row is the last one of the current field while iterating over it
Dim ColRefDatFieldRow As long ' Stores the row number of the reference data where the field begins that was requested via the col parameter
'---------------------------- Analyze Reference Data ---------------------------------------------------------------------------------
For Each r In RefDat.Rows ' Iterate over reference data table
If r.Row = 1 Then ' ignore first row that holds the column headers of the reference data row
ValCount = 0
RowCount = 0
ColCount = 0
ValCountCol = 0
RepCountCol = 1
LastVal = False
Else
If r.Cells(1, 1).Value <> CurField Then ' Next field found
ValCount = 0
ColCount = ColCount + 1
If (ColCount = Col) Then
ColRefDatFieldRow = r.Row ' Remember the row where the field definition of the searched column begins
End If
CurField = r.Cells(1, 1).Value
End If
If r.Cells(2, 1).Value <> r.Cells(1, 1).Value Then ' Last value of this reference data row?
LastVal = True
End If
ValCount = ValCount + 1
If LastVal Then
If RowCount = 0 Then ' At the last row of a reference data field, multiply number of fields with value count of current field
RowCount = ValCount
Else
RowCount = RowCount * ValCount
End If
If ColCount < Col Then ' All values of the previous field lead to a repetition of all values of the current field
RepCountCol = RowCount
ElseIf ColCount = Col Then ' Store the number of fields of the column that was requested with this function call
ValCountCol = ValCount
End If
LastVal = False
End If
End If
Next r
'---------------------------------------- Find value of requested column / row combination -----------------------------------------
Dim rcc As long
Dim vcc As long
Dim dup As long
Dim line As long
line = 0
For rcc = 1 To RepCountCol
For vcc = 1 To ValCountCol
For dup = 1 To RowCount / ValCountCol / RepCountCol
line = line + 1
If line = Row Then
GetValue = RefDat.Cells(ColRefDatFieldRow + vcc - 1, 2)
Exit For
End If
Next dup
Next vcc
Next rcc
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.