Myby this is all too late but if not you might be able to find some thing here:
Private Sub UpdateStatus()
Dim CurrentRow As Long, CurrentCol As Long, myDay As Integer
Dim myRow As Long
Planning.Enabled = False
With Planning
CurrentCol = .col
CurrentRow = .row
.Clear
initializeGrid
PopulatePlanning
.RowSel = 1
For myRow = .RowSel To .Rows - 1
OneRowUpdateStatus .TextMatrix(myRow, 0), myRow
Next myRow
.col = CurrentCol
.row = CurrentRow
End With
Planning.Enabled = True
End Sub
Private Sub OneRowUpdateStatus(BoxID As String, myRow As Long)
Dim myDay As Integer
Dim Missing As Integer
Set cnn = CurrentProject.Connection
With Planning
Re.Open "SELECT Day([MonthPlan].[Dato]) AS myDay, COUNT(MonthPlan.ID) AS Total FROM MonthPlan Where BoxID='" & BoxID & "' And month(Dato)=" & m_lMonth & " And Year(Dato) = " & m_lYear & " GROUP BY Day([MonthPlan].[Dato])", cnn, adOpenKeyset, adLockOptimistic
ReMiss.Open "SELECT Dato, COUNT(ID) AS Missing, BoxID, FirmaID FROM dbo.MonthPlan WHERE (KundeID IS NULL) OR (PlanlagtTimer IS NULL) AND BoxID='" & BoxID & "' And month(Dato)=" & m_lMonth & " And Year(Dato) = " & m_lYear & " GROUP BY Dato, KundeID, BoxID, FirmaID", cnn, adOpenKeyset, adLockOptimistic
Do Until (Re.EOF)
myDay = Day(Re!myDay)
If IsNull(ReMiss!Missing) Then
.TextMatrix(myRow, myDay + 2) = Re!Total
.row = myRow
.col = myDay + 2
.CellBackColor = vbGreen
Else
Do Until ReMiss.EOF
Missing = Missing + ReMiss!Missing
ReMiss.MoveNext
Loop
ReMiss.MoveFirst
.TextMatrix(myRow, myDay + 2) = Re!Total & "-" & Missing - 1
.row = myRow
.col = myDay + 2
.CellBackColor = vbRed
End If
Re.MoveNext
Loop
End With
ReMiss.Close
Re.Close
End Sub
Herman