Group via date MSFlexgrid problem
Hi everyone,
I am having problem with these codes. I should sum up the values grouping them via date.
I think the problem is when i add those values. I can't find a workaround for this.
The code is there can someone modify the codes for me.
Any help is greatly appreciated. Thanks.
Code:
Private Sub Command1_Click()
Dim lngIndex As Long, j As Long, i As Long
Dim h1() As Double, h2() As Double, h3() As Double, h4() As Double, h5() As Double, h6() As String
Dim hh1 As Double, hh2 As Double, hh3 As Double, hh4 As Double, hh5 As Double, hh6 As String
lngIndex = 1
Do While lngIndex < MSHFlexGrid1.Rows
With MSHFlexGrid1
If Len(Trim(.TextMatrix(lngIndex, 6))) <> 0 Then
If .TextMatrix(lngIndex, 6) = .TextMatrix(lngIndex + 1, 6) Then
hh1 = hh1 + CLng(.TextMatrix(lngIndex, 1)) + CLng(.TextMatrix(lngIndex + 1, 1))
hh2 = hh2 + CDbl(.TextMatrix(lngIndex, 2)) + CDbl(.TextMatrix(lngIndex + 1, 2))
hh3 = hh3 + CDbl(.TextMatrix(lngIndex, 3)) + CDbl(.TextMatrix(lngIndex + 1, 3))
hh4 = hh4 + CDbl(.TextMatrix(lngIndex, 4)) + CDbl(.TextMatrix(lngIndex + 1, 4))
hh5 = hh5 + CDbl(.TextMatrix(lngIndex, 5)) + CDbl(.TextMatrix(lngIndex + 1, 5))
hh6 = .TextMatrix(lngIndex, 6)
Else
j = j + 1
ReDim Preserve h1(j): ReDim Preserve h2(j): ReDim Preserve h3(j)
ReDim Preserve h4(j): ReDim Preserve h5(j): ReDim Preserve h6(j)
If hh6 = "" Then
h1(j) = .TextMatrix(lngIndex, 1): h2(j) = .TextMatrix(lngIndex, 2)
h3(j) = .TextMatrix(lngIndex, 3): h4(j) = .TextMatrix(lngIndex, 4)
h5(j) = .TextMatrix(lngIndex, 5): h6(j) = .TextMatrix(lngIndex, 6)
Else
h1(j) = hh1: h2(j) = hh2: h3(j) = hh3
h4(j) = hh4: h5(j) = hh5: h6(j) = hh6
End If
hh1 = 0: hh2 = 0: hh3 = 0: hh4 = 0: hh5 = 0: hh6 = ""
End If
End If
End With
lngIndex = lngIndex + 1
Loop
For i = 1 To MSHFlexGrid1.Rows - 1
MSHFlexGrid1.TextMatrix(i, 1) = "": MSHFlexGrid1.TextMatrix(i, 2) = ""
MSHFlexGrid1.TextMatrix(i, 3) = "": MSHFlexGrid1.TextMatrix(i, 4) = ""
MSHFlexGrid1.TextMatrix(i, 5) = "": MSHFlexGrid1.TextMatrix(i, 6) = ""
Next i
For i = 1 To UBound(h1)
With MSHFlexGrid1
.TextMatrix(i, 1) = h1(i): .TextMatrix(i, 2) = h2(i)
.TextMatrix(i, 3) = h3(i): .TextMatrix(i, 4) = h4(i)
.TextMatrix(i, 5) = h5(i): .TextMatrix(i, 6) = h6(i)
End With
Next i
End Sub
Private Sub Form_Load()
Dim i As Long, j As Long, Rw As Long, Cl As Long
MSHFlexGrid1.Cols = 7
MSHFlexGrid1.Rows = 8
MSHFlexGrid1.TextMatrix(0, 1) = "Report COunt"
MSHFlexGrid1.TextMatrix(0, 2) = "header2"
MSHFlexGrid1.TextMatrix(0, 3) = "header3"
MSHFlexGrid1.TextMatrix(0, 4) = "header4"
MSHFlexGrid1.TextMatrix(0, 5) = "header5"
MSHFlexGrid1.TextMatrix(0, 6) = "Date"
MSHFlexGrid1.TextMatrix(1, 1) = 156
MSHFlexGrid1.TextMatrix(1, 2) = 4465.85
MSHFlexGrid1.TextMatrix(1, 3) = 491.2435
MSHFlexGrid1.TextMatrix(1, 4) = 284.41
MSHFlexGrid1.TextMatrix(1, 5) = 34.1292
MSHFlexGrid1.TextMatrix(1, 6) = "1/1/2011"
MSHFlexGrid1.TextMatrix(2, 1) = 1
MSHFlexGrid1.TextMatrix(2, 2) = 2
MSHFlexGrid1.TextMatrix(2, 3) = 3
MSHFlexGrid1.TextMatrix(2, 4) = 4
MSHFlexGrid1.TextMatrix(2, 5) = 5
MSHFlexGrid1.TextMatrix(2, 6) = "2/1/2011"
MSHFlexGrid1.TextMatrix(3, 1) = 1
MSHFlexGrid1.TextMatrix(3, 2) = 1
MSHFlexGrid1.TextMatrix(3, 3) = 1
MSHFlexGrid1.TextMatrix(3, 4) = 1
MSHFlexGrid1.TextMatrix(3, 5) = 1
MSHFlexGrid1.TextMatrix(3, 6) = "3/1/2011"
MSHFlexGrid1.TextMatrix(4, 1) = 1
MSHFlexGrid1.TextMatrix(4, 2) = 1
MSHFlexGrid1.TextMatrix(4, 3) = 1
MSHFlexGrid1.TextMatrix(4, 4) = 1
MSHFlexGrid1.TextMatrix(4, 5) = 1
MSHFlexGrid1.TextMatrix(4, 6) = "3/1/2011"
MSHFlexGrid1.TextMatrix(5, 1) = 1
MSHFlexGrid1.TextMatrix(5, 2) = 1
MSHFlexGrid1.TextMatrix(5, 3) = 1
MSHFlexGrid1.TextMatrix(5, 4) = 1
MSHFlexGrid1.TextMatrix(5, 5) = 1
MSHFlexGrid1.TextMatrix(5, 6) = "3/1/2011"
MSHFlexGrid1.TextMatrix(6, 1) = 1
MSHFlexGrid1.TextMatrix(6, 2) = 1
MSHFlexGrid1.TextMatrix(6, 3) = 1
MSHFlexGrid1.TextMatrix(6, 4) = 1
MSHFlexGrid1.TextMatrix(6, 5) = 1
MSHFlexGrid1.TextMatrix(6, 6) = "3/1/2011"
End Sub
Re: Group via date MSFlexgrid problem
For example the given is:
2 2 2 2 1/1/2011
1 1 1 1 2/1/2011
1 1 1 1 3/1/2011
2 2 2 2 3/1/2011
1 2 3 4 3/1/2011
The output i wanted is like this (Group by Date)
2 2 2 2 1/1/2011
1 1 1 1 2/1/2011
4 5 6 7 3/1/2011
1 Attachment(s)
Re: Group via date MSFlexgrid problem
Oof! That sure is a lot of work anyway.
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
Re: Group via date MSFlexgrid problem
Zynder
Maybe something like this:
Code:
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
Hope that gives you some ideas
Spoo
