'Count the number of fields or column
MyFieldCount = rs.Fields.Count
'Fill the first line with the name of the fields
For MyIndex = 0 To MyFieldCount - 1
ApExcel.Cells(InitRow, (MyIndex + 1)).Formula = rs.Fields(MyIndex).name 'Write Title to a Cell
ApExcel.Cells(InitRow, (MyIndex + 1)).Font.Bold = True
ApExcel.Cells(InitRow, (MyIndex + 1)).Interior.ColorIndex = 36
ApExcel.Cells(InitRow, (MyIndex + 1)).WrapText = True
Next
ApExcel.Cells(InitRow, MyIndex + 1).Formula = "Header1"
ApExcel.Cells(InitRow, MyIndex + 1).Interior.ColorIndex = 40
ApExcel.Cells(InitRow, MyIndex + 2).Formula = "Header2"
ApExcel.Cells(InitRow, MyIndex + 2).Interior.Color = RGB(130, 130, 255)
ApExcel.Cells(InitRow, MyIndex + 3).Formula = "Header3"
ApExcel.Cells(InitRow, MyIndex + 3).Interior.ColorIndex = 42
ApExcel.Cells(InitRow, MyIndex + 4).Formula = "Header4"
ApExcel.Cells(InitRow, MyIndex + 4).Interior.ColorIndex = 43
'Draw border on the title line
MyLetter = Switch((MyIndex + 4) \ 26 = 0, "A", (MyIndex + 4) \ 26 = 1, "B", (MyIndex + 4) \ 26 = 2, "C", (MyIndex + 4) \ 26 = 4, "D", (MyIndex + 4) \ 26 = 5, "E")
MyLetter = MyLetter & Chr((64 + (MyIndex + 4) Mod 26)) & InitRow
With ApExcel.Range("A" & InitRow & ":" & MyLetter).Borders(xlEdgeBottom)
.Color = RGB(0, 0, 0)
.LineStyle = xlContinuous
.Weight = xlThick
End With
MyRecordCount = 1 + InitRow
'Fill the excel book with the values from the database
Do While rs.EOF = False
For MyIndex = 1 To MyFieldCount
ApExcel.Cells(MyRecordCount, MyIndex).Formula = rs((MyIndex - 1)).Value 'Write Value to a Cell
ApExcel.Cells(MyRecordCount, MyIndex).WrapText = False 'Format the Cell
Next
TDrst.Open "Select PoolID,TurndownCode,Comments,TurndownDate FROM tbl_Turndowns WHERE Loan_ID = '" & rs(0).Value & "'", cn
i = 0
Do While TDrst.EOF = False
ApExcel.Cells(MyRecordCount, MyIndex + i).Formula = TDrst((0)).Value
ApExcel.Cells(MyRecordCount, MyIndex + i).Interior.ColorIndex = 40
ApExcel.Cells(MyRecordCount, MyIndex + i).WrapText = False
ApExcel.Cells(MyRecordCount, MyIndex + i + 1).Formula = TDrst((1)).Value
ApExcel.Cells(MyRecordCount, MyIndex + i + 1).Interior.Color = RGB(130, 130, 255)
ApExcel.Cells(MyRecordCount, MyIndex + i + 1).WrapText = False
ApExcel.Cells(MyRecordCount, MyIndex + i + 2).Formula = TDrst((2)).Value
ApExcel.Cells(MyRecordCount, MyIndex + i + 2).Interior.ColorIndex = 42
ApExcel.Cells(MyRecordCount, MyIndex + i + 2).WrapText = False
ApExcel.Cells(MyRecordCount, MyIndex + i + 3).Formula = TDrst((3)).Value
ApExcel.Cells(MyRecordCount, MyIndex + i + 3).Interior.ColorIndex = 43
ApExcel.Cells(MyRecordCount, MyIndex + i + 3).WrapText = False
i = i + 4
TDrst.MoveNext
Loop
MyRecordCount = MyRecordCount + 1
TDrst.Close
rs.MoveNext
'If MyRecordCount > 50 Then
' Exit Do
'End If
Loop
'Suggest to the user to save it's work
' Response = MsgBox("Save the Excel Sheet and clik OK", vbOKOnly, "Save your file")
'Close the connection with the DB
rs.Close
ApExcel.Visible = True