Here’s a User Defined Function (UDF) that takes the source range and two other parameters and returns an array result with the desired data format.
Really, it’s very straightforward. The happy fact is that you can determine the dimensions of the resulting array upfront just by looking at the fact that you have three kinds of cells in the source range: unoccupied, header, and entry. I’ve put ample documenting comments in the code to explain, I hope. I’m new to this forum (at least as far as posting) so my apologies if I could have formatted this better.
Option Explicit
'Convert denormalized entries to normalized list of entries
'I.e. Un-nest data fields for key/header field(s) and any following n-tuples of data fields
'NOTE: Requires all source data to be contiguous from upper left cell of source data range
Function Normalizer(SourceRange As Variant, FieldsPerEntry As Integer, FieldsPerHeader As Integer)
Dim Result() As Variant
Dim Dummy As Integer
Dim OccupiedCellCount As Integer
Dim HeaderCellCount As Integer
Dim EntryCellCount As Integer
Dim EntryCount As Integer
Dim SourceRowPtr As Integer
Dim SourceColumnPtr As Integer
Dim ResultRowPtr As Integer
Dim ResultColumnPtr As Integer
Dim Offset As Integer
'Terms:
' Header - the lead cell in a denormalized list that is what is in common for each entry
' Entry - a set of n fields that follow (possibly in multiples) a header
' Field - a single datum that is not a header
' Example data:
' Paper100, Speaker1Name, Speaker1Email, Speaker2Name, Speaker2Email
' Header: Paper100
' Fields (2 count): Name, Email
' Entries (2 count): Speaker1Name, Speaker1Email --and-- Speaker2Name, Speaker2Email
' NOTE: LO Calc ranges are managed as 1-based arrays
'Establish it is a two-dimensional array, i.e. a range
Dummy = -1
On Error Resume Next
Dummy = Ubound(SourceRange, 2)
If Dummy = -1 Then
Normalizer = CVErr(502) 'Won't be a "real" Err:502, but will show as Error: 502
Exit Function
End If
On Error Goto 0
'Find how many cells within source range are occupied
OccupiedCellCount = 0
For SourceRowPtr = LBound(SourceRange) To UBound(SourceRange)
For SourceColumnPtr = LBound(SourceRange, 2) To UBound(SourceRange, 2)
If Not (SourceRange(SourceRowPtr, SourceColumnPtr) = "") Then OccupiedCellCount = OccupiedCellCount + 1
Next SourceColumnPtr
Next SourceRowPtr
'Find how many source range cells are headers
' Which is just FieldsPerHeader per source range row
HeaderCellCount = (UBound(SourceRange) - LBound(SourceRange) + 1) * FieldsPerHeader
'Find how many source range cells are part of entries
' If occupied, must be header cell or entry cell
EntryCellCount = OccupiedCellCount - HeaderCellCount
'Find how many entries are in the source range
' This will determine the number of rows of the result array
EntryCount = EntryCellCount \ FieldsPerEntry
'Create the result array
ReDim Result(1 To EntryCount, 1 To FieldsPerHeader + FieldsPerEntry)
'Xray REsult
'Step through the source range and parcel out to result array
ResultRowPtr = 1
For SourceRowPtr = LBound(SourceRange) To UBound(SourceRange)
SourceColumnPtr = FieldsPerHeader + 1
Do While SourceColumnPtr <= UBound(SourceRange, 2)
If (Trim(SourceRange(SourceRowPtr, SourceColumnPtr)) <> "") And Not (IsEmpty(SourceRange(SourceRowPtr, SourceColumnPtr))) Then
For Offset = 1 to FieldsPerHeader
Result(ResultRowPtr, Offset) = SourceRange(SourceRowPtr, Offset)
Next Offset
For Offset = 0 to FieldsPerEntry - 1
ResultColumnPtr = FieldsPerHeader + (Offset + 1) 'Advance 1, 2 etc., past header cell(s)
Result(ResultRowPtr, ResultColumnPtr) = SourceRange(SourceRowPtr, SourceColumnPtr + Offset)
Next Offset
ResultRowPtr = ResultRowPtr + 1 'WIll advance out of bounds at end, but won't be used then
End If
SourceColumnPtr = SourceColumnPtr + FieldsPerEntry
Loop
Next SourceRowPtr
Normalizer = Result
End Function
Speaker100.ods (14.8 KB)
