Hallo,
I have a table that contain some fields: id, start_hour, end_hour, room, organization.
I'm trying to transfer this information to an excel sheet in order to build a timetable that will look like this:

8:00 9:00 10:00 11:00 12:00
Room1 org1org1org1
Room2 org2org2org2
Room3

and so on. No problem with transferring the hours and the rooms. The problem comes with transferring the organization name because there are three things to check: the room name, the start hour and the end hour. Then taking the correpsonding organization name and placing it and merging the cells from its starting hour to its ending hour.

Here the code I'm using:

Sub Export_To_Excel()

Dim strSql As String
Dim strSQL2 As String
Dim strSQL3 As String
Dim dBase As DAO.Database
Dim rs As DAO.Recordset
Dim rs3 As DAO.Recordset
Dim i As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim d As Integer
Dim h As Integer
Dim uRow As Integer
Dim rs2 As DAO.Recordset
Dim i2 As Integer
Dim uRow2 As Integer
Dim stanza As String
Dim oraInizio As Date
Dim oraFine As Date
Dim xlApp As Object
Dim Sht As Object
Dim RecordQuantity As String
Dim RecordQuantity2 As String
Dim i3 As Integer
Dim g As Integer
Dim k As Integer
Dim n As Integer
Dim m As Integer

DoCmd.SetWarnings False
'setup query to get all records from a table
strSql = "SELECT * FROM [Qry_Room];"
strSQL2 = "SELECT * FROM [Qry_AllHours]"
strSQL3 = "SELECT * FROM [Table2]"
RecordQuantity = DCount("[Room]", "qry_Room") + 3
RecordQuantity2 = DCount("[Ora_InizioID]", "qry_Allhours")

Set dBase = CurrentDb()
Set rs = dBase.OpenRecordset(strSql, dbOpenDynaset)
Set rs2 = dBase.OpenRecordset(strSQL2, dbOpenDynaset)
Set rs3 = dBase.OpenRecordset(strSQL3, dbOpenDynaset)
'Create Excel object
Set xlApp = CreateObject("Excel.Application")
xlApp.Workbooks.Add
xlApp.Visible = True
Set Sht = xlApp.ActiveWorkbook.Sheets(1)
uRow = 4



' Loop through the Rooms and copy them to worksheet.

Do Until rs.EOF
For i = 0 To rs.Fields.Count - 1
Sht.Cells(uRow, i + 1).Value = rs(i)
Next i
rs.MoveNext
uRow = uRow + 1
Loop




' Loop to add the timeslot

uRow2 = 2
h = 3
Do Until rs2.EOF
Sht.Cells(uRow2, h).Value = rs2(i2)
rs2.MoveNext
h = h + 3
Loop

With Sht
.Rows("2").NumberFormat = "hh:mm"
End With



' Loop to add the organizations:

k = 4
g = 3
n = 3
m = 3
Do Until rs3.EOF
stanza = rs3(i3 + 3)
oraInizio = rs3(i3 + 1)
oraFine = rs3(i3 + 2)
If Sht.Cells(k, 1).Value = stanza And Sht.Cells(2, g).Value = oraInizio Then
Sht.Cells(k, g + 1).Value = rs3(i3 + 4)

' here is the problem:

Do Until Sht.Cells(2, n).Value = oraFine
If Sht.Cells(2, n).Value = oraFine Then
With Sht
.Range(.Cells(k, g + 1), .Cells(k, n - 1)).merge
End With
n = 3
m = 3
Else
'm = m + 1
n = n + 1
End If
Loop

k = 4
g = 3
rs3.MoveNext
Else
k = k + 1
If k > RecordQuantity Then
k = 4
g = g + 1
End If
End If
Loop








'Here's where the formatting happens

a = 3
b = 4
c = 2
d = 3


With Sht
.Name = "Timetable"
.Rows("4:" & RecordQuantity).RowHeight = 36
.Rows(2).Font.Bold = True
.Columns(1).Font.Bold = True
.Cells.Interior.ColorIndex = "2"
Do Until b = RecordQuantity2 * 3 + 3 + 1
.Range(.Cells(2, c), .Cells(2, b)).merge
b = b + 3
c = c + 3
Loop

Do Until d = RecordQuantity2 * 3 + 3
.Range(.Cells(1, d), .Cells(RecordQuantity, d)).Interior.ColorIndex = "6"
d = d + 3
Loop

.Columns("A").Autofit
.Rows("2").HorizontalAlignment = 3
.Rows("2").VerticalAlignment = 2

.Rows("4:" & RecordQuantity).VerticalAlignment = 2


Do Until a = RecordQuantity2 * 3 + 3
.Columns(a).ColumnWidth = 0.4
a = a + 3
Loop



End With



Set Sht = Nothing
xlApp.Quit
Set xlApp = Nothing
Set rs = Nothing
Set rs2 = Nothing
Set dBase = Nothing
End Sub



any suggestion is appreciated