How to shade Cell in Excel based on the Date Value in the Excel Column

[itchock]

Hai ,

I export the content of the MSHFlexgrid to ExcelSheet , Here with i have attached my Excel sheet. The below is the Code i use to export the Excel Sheet. If you see Excel Sheet attached you can find the cells shaded. The code is working fine,

I need a alteration in it. I need to shade the Cell based on the Value in the Column DOffStrm,

if the value in that column is below 30 and the T & I Ets/Ospas date begins with 1 (ex: 3/01/2007)
then the shade should be inside one cell,


suppose the Column DOffStrm is 30 and the Date value of T & I Ets/Ospas is 3/15/2007 then shade should start from half of the current cell and end in the second half of the next cell.

Kindly check this and tell me.



Code:Private Sub cmdExport_Click()
Dim MDur As Integer
Dim obj1 As New Excel.Application
Dim wsheet As Worksheet
Dim wbook As Workbook

Screen.MousePointer = vbHourglass

Set wbook = obj1.Workbooks.Add
Set wsheet = obj1.Sheets(1)
Dim i%
Dim j%
Dim Ce%

For i = 0 To MSHFlexGrid1.Rows - 1
For j = 0 To MSHFlexGrid1.Cols - 1

If j > 7 And j < 55 And i > 1 And Len(MSHFlexGrid1.TextMatrix(i, j)) > 1 Then
MDur = MSHFlexGrid1.TextMatrix(i, 55)
MDur = MDur / 30
wsheet.Cells(i + 2, j + 1).Value = Format(MSHFlexGrid1.TextMatrix(i, j), "dd")
wsheet.Cells(i + 2, j + 1).Font.Bold = True
obj1.ActiveSheet.Cells(i, j).Font.Color = vbRed
obj1.ActiveSheet.Cells(i + 2, j + 1).Interior.Color = vbYellow
For Ce = 0 To MDur

Next
ElseIf j > 7 And j < 55 Then
wsheet.Cells(i + 2, j + 1).Value = MSHFlexGrid1.TextMatrix(i, j)
wsheet.Cells(i + 2, j + 1).Font.Bold = True
Else
wsheet.Cells(i + 2, j + 1).Value = MSHFlexGrid1.TextMatrix(i, j)
End If
Next
Next

For i = 0 To 1
For j = 0 To MSHFlexGrid1.Cols - 1
wsheet.Cells(i + 2, j + 1).Font.Bold = True
wsheet.Cells(i + 2, j + 1).Font.Color = &H800000
Next
Next
Application.DisplayAlerts = False
With obj1.Sheets(1).Range("H2:S2")
.Select
.Merge
End With

With obj1.Sheets(1).Range("T2:AE2")
.Select
.Merge
End With

With obj1.Sheets(1).Range("AF2:AQ2")
.Select
.Merge
End With

With obj1.Sheets(1).Range("AR2:BC2")
.Select
.Merge
End With
obj1.Rows(2).HorizontalAlignment = Excel.xlCenter
obj1.Columns.AutoFit
Screen.MousePointer = vbNormal
obj1.Application.Visible = True
End Sub

Thankyou,
Chock.