Data binding and a fabricated Recordset makes this a bit easier:
Code:
Option Explicit
Private rsOrig As ADODB.Recordset
Private rsGrouped As ADODB.Recordset
Private FieldNums As Variant
Private Function FabricateRS() As ADODB.Recordset
Set FabricateRS = New ADODB.Recordset
With FabricateRS
.CursorLocation = adUseClient
With .Fields
.Append "A", adDouble
.Append "B", adDouble
.Append "C", adDouble
.Append "D", adDouble
.Append "Date Value", adDate
End With
.Open
End With
End Function
Private Sub cmdGroup_Click()
Dim A As Double, B As Double, C As Double, D As Double
Dim DateValue As Date
cmdGroup.Enabled = False
With rsOrig
.Sort = "[Date Value] ASC"
Set rsGrouped = FabricateRS()
Do
A = A + !A.Value
B = B + !B.Value
C = C + !C.Value
D = D + !D.Value
DateValue = ![Date Value].Value
.MoveNext
If .EOF Then
rsGrouped.AddNew FieldNums, Array(A, B, C, D, DateValue)
Exit Do
ElseIf DateValue <> ![Date Value].Value Then
rsGrouped.AddNew FieldNums, Array(A, B, C, D, DateValue)
A = 0
B = 0
C = 0
D = 0
End If
Loop
.Close
End With
Set rsOrig = Nothing
Set MSHFlexGrid.DataSource = rsGrouped
rsGrouped.Close
Set rsGrouped = Nothing
End Sub
Private Sub cmdLoad_Click()
cmdLoad.Enabled = False
Set rsOrig = FabricateRS()
With rsOrig
.AddNew FieldNums, Array(2, 2, 2, 2, #1/1/2011#)
.AddNew FieldNums, Array(1, 1, 1, 1, #2/1/2011#)
.AddNew FieldNums, Array(1, 1, 1, 1, #3/1/2011#)
.AddNew FieldNums, Array(2, 2, 2, 2, #3/1/2011#)
.AddNew FieldNums, Array(1, 2, 3, 4, #3/1/2011#)
End With
Set MSHFlexGrid.DataSource = rsOrig
cmdGroup.Enabled = True
End Sub
Private Sub Form_Load()
FieldNums = Array(0, 1, 2, 3, 4)
End Sub
Private Sub Command1_Click()
'
Dim aaGrp()
With MSFlexGrid1
ReDim aaGrp(.Rows, 6)
aa = 0
For rr = 1 To .Rows - 1
fgdate = .TextMatrix(rr, 6)
' same date, update totals in col's 1-5
If fgdate = aaGrp(aa, 6) Then
For cc = 1 To 5
aaGrp(aa, cc) = aaGrp(aa, cc) + Val(.TextMatrix(rr, cc))
Next cc
' new date -- populate a new aaGrp "record"
Else
aa = aa + 1
For cc = 1 To 5
aaGrp(aa, cc) = Val(.TextMatrix(rr, cc))
Next cc
aaGrp(aa, 6) = .TextMatrix(rr, 6)
End If
Next rr
End With
'
End Sub
Comments:
Your Sub Form_Load() remains as is
I have utilized a 2-D array aaGrp to hold the summations
it is oversized .. but shouldn't be an issue
no ReDim's are used .. should be a little faster
counters rr and cc refer to the FG's row and col, respectively
counter aa refers to array's "record" (row number) and is updated independently
I have simplified things here
I didn't fill col 0 in the array
I just used Val() for cols 1 thru 5
The date remains as text
The above algo assumes that dates in the FG are chronological
ie, dates may be repeated, but dates never go backwards
if this is an incorrect assumption, then additional date testing will be needed
Reply With Quote
