If you know what cross tabulation is you may have a need for this. If you've never heard of it the chances are this may just be a really confusing bit of code.
Quite often we're dealing with data from a database, and many DBMSs offer a built-in way to do this. For example for Jet/ACE SQL look up the TRANSFORM... PIVOT syntax. Normally this makes use of some aggregation function (SUM(), AVERAGE(), etc.).
This Tabulator class can be used with any data source. This version does not include aggregation support, but instead assumes you have simple unique value to collect for each intersection of Column and Row (i.e. "cell").
It can return rows in ascending order (default) or descending order by RowId value. Columns are always in ascending order by ColName values.
You might add aggregation a number of ways. You could hard-code that into Tabulator.cls or the TabulatorValue.cls (a helper class for value storage).
Or you might modify Tabulator.cls to accept an object reference that offers fixed-named methods such as Accumulate() and Report(). For SUM() aggregation Accumulate() might just add new values to the current sum in a cell, and Report() would jsut return the value without modification. For something like AVERAGE() you might have to add values and increment a count in Accumulate() and then divide in the Report() method.
An illustration may help. This is Project1 in the attached archive. Here we have data like:
We cross tabulate Price by Date and Commodity and display that (descending) in an MSHFlexGrid control:
Project2 is another example, showing how Tabulate can handle complex values which can be arrays or even objects. Here each cell Value is an instance of a two-value class (Price and Volume).
We'll tabulate this and report it in another MSHFlexGrid control:
Tabulate works by storing row data as a Collection of row Collection objects, RowId values as a Variant array, and "cell" values as TabulateValue.cls instances, each of which have a Variant property.
Peformance was improved by adding a binary search for doing row insertion. Since there are normally far fewer columns, a linear search is still being used to insert new columns as they are "put" into Tabulator. At this point Tabulator is reasonably fast, and the demo programs spend most of their time populating the grid after tabulation has completed.
It seems to be working properly, but if you find bugs please let everyone know by posting a reply here.
Note:
Bug fixed, reposted attachment.
Last edited by dilettante; Apr 27th, 2014 at 10:06 AM.
Reason: Fixed bug, reposted attachment
This one uses a modified version of Tabulator that supports a simple aggregation call to a caller-provided Aggregator object (in this case the calling Form itself). Here I have implemented a SUM() type aggregation, an easy one.
This time the data inputs are Tab-delimited files with a header row (which I just skip). These are "sales data" figures to be tabulated by Rep and Quarter.
Note:
Bug fixed, reposted attachment.
Last edited by dilettante; Apr 27th, 2014 at 10:07 AM.
Reason: Bug fixed, reposted attachment
Since the data-files in your example(s) contain Dates, formatted with english Month-Names,
I've added a language-aware CDate-function to the Form-Code, to make it work on a german system
(also had to change CCur(EnglishFloatString) to CCur(Val(EnglishFloatString)) ...)
Whilst playing around with the first Zip-Download (and the simpler Project1.vbp it contains),
there's a missing adaption to your latest changes of the Tabulator-Class I htink...
Here's the Form1.frm Code with my changes (with comments where I made them):
Code:
Option Explicit
'
'Assumes that all data files are in DATA_FOLDER.
'
'Each is a text file with one record per line of text. Fields are
'delimited by a single space " " and are as follows:
'
' Field 1 COMMODITY String.
' Field 2 DATE Date (any fixed date format that can be
' accurately parsed by CDate() calls).
' Field 3 PRICE Currency (without currency symbol so it
' can be parsed accurately by CCur() calls).
'
'Example record:
'
' "GOLD 05-MAR-2014 83.78"
'
Private Const DATA_FOLDER As String = "$PATH$\datafiles1"
Private Tabulator As Tabulator
Private RecordCount As Long
Private RowCount As Long
'**** had to introduce that, to successfully read the Dates with engl. Month-Names on a german system
Private Declare Function VarDateFromStr& Lib "oleaut32" (ByVal sDate&, ByVal LCID&, ByVal Flags&, D As Date)
Private Function CDateLA(sDate, Optional ByVal LCID As Long)
Dim HRes As Long: Const LOCALE_NOUSEROVERRIDE& = &H80000000
HRes = VarDateFromStr(StrPtr(sDate), LCID, LOCALE_NOUSEROVERRIDE, CDateLA)
If HRes Then Err.Raise HRes
End Function
'**** end of Locale-Aware CDate-Functionality *********
Private Sub Tabulate()
Dim DataFolder As String
Dim FileName As String
Dim InFile As Integer
Dim Record As String
Dim Fields() As String
Set Tabulator = New Tabulator
Tabulator.RowName = "DATE"
DataFolder = Replace$(DATA_FOLDER, "$PATH$", App.Path)
FileName = Dir$(DataFolder & "\*.txt")
Do While Len(FileName) > 0
If (GetAttr(DataFolder & "\" & FileName) And vbDirectory) = 0 Then
InFile = FreeFile(0)
Open DataFolder & "\" & FileName For Input As #InFile
Do Until EOF(InFile)
Line Input #InFile, Record
RecordCount = RecordCount + 1
Fields = Split(Record, " ")
' Tabulator.PutValue Fields(0), CDate(Fields(1)), CCur(Fields(2))
'changes to the above to make it locale-aware (also note the Val() below)
Tabulator.PutValue Fields(0), CDateLA(Fields(1), 1033), CCur(Val(Fields(2)))
Loop
Close #InFile
End If
FileName = Dir$()
Loop
End Sub
Private Sub Report()
Dim Col As Long
Dim Row As Long
Dim Value As Variant
With flexData
.Rows = Tabulator.RowCount + 1
.Cols = Tabulator.ColCount + 1
.Row = 0
For Col = 0 To Tabulator.ColCount
.Col = Col
.Text = Tabulator.ColName(Col)
.ColWidth(Col) = 1350
.CellAlignment = flexAlignCenterCenter
Next
Tabulator.GetByRowsDescending = True
For Row = 1 To Tabulator.RowCount
.Row = Row
.Col = 0
.CellAlignment = flexAlignCenterCenter
.Text = UCase$(Format$(Tabulator.RowId(Row), "DD-MMM-YYYY"))
For Col = 1 To Tabulator.ColCount
.Col = Col
' Value = Tabulator.GetValue(Col, Row)
'had to use it this way instead (perhaps due to last changes on the Tabulator-Class)
Tabulator.GetValue Col, Row, Value
If IsNull(Value) Then
.CellAlignment = flexAlignCenterCenter
.Text = "–"
Else
.CellAlignment = flexAlignRightCenter
.Text = Format$(Value, "$#,###.00")
End If
Next
Next
End With
RowCount = Tabulator.RowCount
Set Tabulator = Nothing
End Sub
Private Sub Form_Load()
Show
MousePointer = vbHourglass
StatusBar.SimpleText = "Tabulating..."
StatusBar.Refresh
Tabulate
StatusBar.SimpleText = "Reporting..."
StatusBar.Refresh
Report
MousePointer = vbDefault
StatusBar.SimpleText = "Complete: " _
& Format$(RecordCount, "#,##0") & " records read, " _
& Format$(RowCount, "#,##0") & " rows reported, descending order."
End Sub
Private Sub Form_Resize()
If WindowState <> vbMinimized Then
flexData.Move 0, 0, ScaleWidth, ScaleHeight - StatusBar.Height
End If
End Sub
Another thing is, that when I restrict the input-files to "Gold.txt" only, then the Output
is missing the first entry, coming out this way:
Didn't debug this yet - perhaps you find the problem in a second or two,
being more familiar with the code...
Yes, the original data from the question thread that prompted writing this code was indeed localized. That it why I had added remarks in the Form comments for each field about "accurate parsing." These things (month names, decimal point symbol, etc.) are almost always issues when you are relying on text data.
Thanks for finding that (GOLD-only) bug. It might have eluded me for a long time. I had to single-step through the program and do a bit of head-scratching to find it.
In Tabulator.cls I have changed:
Code:
InsertNotAppend = Mid < mRowCount
to:
Code:
InsertNotAppend = Mid < mRowCount + 1
And yes, there was indeed a problem with the first attachment above that stemmed from changes to accept object-type Values (the signature of GetValue() had changed). That should be repaired now for Project1 in the first attachment.
Last edited by dilettante; Apr 27th, 2014 at 10:21 AM.
Yes, the original data from the question thread that prompted writing this code was indeed localized. That it why I had added remarks in the Form comments for each field about "accurate parsing." These things (month names, decimal point symbol, etc.) are almost always issues when you are relying on text data.
Your comments are currently:
' Field 2 DATE Date (any fixed date format that can be accurately parsed by CDate() calls).
' Field 3 PRICE Currency (without currency symbol so it can be parsed accurately by CCur() calls).
Nothing really wrong with the above - but the concrete Data within the text-files which come with
the Demo cannot be accurately parsed with neither CDate, nor CCur - when used on a non-english locale.
Just saying...
As the Demo is currently, it will only startup successfully for interested VB-folks who work on an english system.
Most of the others will perhaps not be willing to go through all the files changing the Date and Float-Formats
to proper localized ones (or create new Demo-Files from scratch) - or are not aware, what alternatives
they could use (or write), for VBs CDate-function to make it work and "get to the meat" of the Demo.
Olaf
Last edited by Schmidt; Apr 27th, 2014 at 11:18 AM.
Nothing really wrong with the above - but the concrete Data within the text-files which come with
the Demo cannot be accurately parsed with neither CDate, nor CCur - when used on a non-english locale.
Just saying...
As the Demo is currently, it will only startup successfully for interested VB-folks who work on an english system.
An excellent point.
Most VB6 programmers still don't pay any attention to these issues, even though Internet usage is pervasive today. They get into just as much trouble with ANSI conversions both explicit and implicit.
For dates one solution is to avoid text date formats with day or month names in them, at least in data meant to be processed in any way. Of course you can also get into trouble with all-numeric dates (7/1/2001) by making assumptions about which number is day and which is month.
Calling VarDateFromStr() is a good way to bypass this, since there isn't any built-in function I can think of to handle it. Howver I'd probably pass:
Code:
Const LOCALE_INVARIANT = &H7F
... intead of 1033 (US English). Because a date in the format "1-Jul-2001" is universal, i.e. invariant. Yes, they are the same but that's merely historical accident and they had to choose some format as universal.
For numbers with a fractional part things are just as dicey. If you can live with VB6's Val() function (always returns a Double), it always uses the invariant locale. But if that would cost you due differences in range or precision then you are back to making oleaut32.VarCyFromStr() calls for a cleaner job.
Calling VarDateFromStr() is a good way to bypass this, since there isn't any built-in function I can think of to handle it. Howver I'd probably pass:
Code:
Const LOCALE_INVARIANT = &H7F
... intead of 1033 (US English).
I don't like it all that much, because it suggests a kind of "magic" or "universality" it doesn't
really support in the end - it's only (us-)english text-formatting ("en-us") which is recognized
(or expected) by the appropriate functions which get fed with an LCID of LOCALE_INVARIANT.
So why not make it explicit for the reader, what kind of formatted Text is in the DataFiles...
Googling [LCID 1033] will lead to *answers* - googling [LCID 127] will lead to *questions*.
Originally Posted by dilettante
For numbers with a fractional part things are just as dicey. If you can live with VB6's Val() function (always returns a Double), it always uses the invariant locale. But if that would cost you due differences in range or precision then you are back to making oleaut32.VarCyFromStr() calls for a cleaner job.
Good point - better to use a dedicated function which is able to cover the full Currency-String-Range -
although conversion errors (in the last cent-digit) with CCur(Val(SomeEnglishFractionalCurrency)) will not happen
(just tested that here) up to Currency StringValues (having two fractional digits) equal or below:
500,000,000,000.00
Anyways, below are the the two functions which could make the Demo work also on non-english
Systems (even introduced the Invariant-LCID as the Default for the Optional Param now <g>).
Code:
Private Declare Function VarDateFromStr& Lib "oleaut32" (ByVal sDate&, ByVal LCID&, ByVal Flags&, D As Date)
Private Declare Function VarCyFromStr& Lib "oleaut32" (ByVal sDate&, ByVal LCID&, ByVal Flags&, C As Currency)
Private Function CDateLA(sDate, Optional ByVal LCID As Long = 127) As Date
Dim HRes As Long: Const LOCALE_NOUSEROVERRIDE& = &H80000000
HRes = VarDateFromStr(StrPtr(sDate), LCID, LOCALE_NOUSEROVERRIDE, CDateLA)
If HRes Then Err.Raise HRes
End Function
Private Function CCurLA(sDate, Optional ByVal LCID As Long = 127) As Currency
Dim HRes As Long: Const LOCALE_NOUSEROVERRIDE& = &H80000000
HRes = VarCyFromStr(StrPtr(sDate), LCID, LOCALE_NOUSEROVERRIDE, CCurLA)
If HRes Then Err.Raise HRes
End Function
I suppose it doesn't matter to me one way or another, these are really I/O related issues far beyond of the scope of this thread.
However it doesn't hurt that you pointed them out and provided a solution.
I'm a little surprised there isn't a separate forum for these National/International/Global issues. We sure get enough random question/problem threads that run aground on such rocks.
It uses a modified version of Tabulator.cls (marked version 3) that uses a larger helper class now named TabulatorCell.cls to automagically calculate a few simple aggregate functions:
Avg, Count, First, Last, Max, Min, Sum
This means a cell no longer has a "value" after tabulation, because unlike the prior versions this one assumes any given cell may well have multiple values in the input data. This is more consistent with typical crosstab use. For the single-use case you can simply retrieve First or Last though.
First and Last are based on the order of insertion of values for a cell and doesn't imply any internal sorting. You could sort the data before submitting it to Tabulator if you want First to imply "lowest value" and Last to imply "highest value."
Doing this extra work does cost a bit of performance. It also means some tradeoffs have to be made to avoid things like overflows (example: Sum of Integer data is stored as Decimal type data here). There may also be new bugs introduced in this version that haven't been uncovered yet.
The demo Project this version 3 is embedded in just makes use of the Avg values after tabulation. But it could use and display more than one statistic, since all of them are available.
It has the same sort of localized data (month names, decimal points) so be aware of this when testing with non-English locale settings.
Edit:
Reposted attachment. Project had an unused class carried over from previous projects. This has been removed.
Last edited by dilettante; May 1st, 2014 at 02:26 PM.
Reason: reposted attachment
Reply With Quote
Originally Posted by dilettante
