Excel code in access

[Dave Eyley]

Thanks to both Carl and Peter for your responses and dedication...

It works well now but for the last bit - it leaves Excel open as a Process in Task Manager when there's no apparent spreadsheet open.
Any subsequent attempts to output to the spreadsheet results in a seemingly random error...

Dave

 

[Bat17]

did you try the

xlApp.UserControl = False

Peter

 

[Dave Eyley]

Yes I did as you suggested but to no avail...

Still stuck for a moment but I'm so close now I don't intend giving up...
Your help is very much appreciated.

Dave

 

[Bat17]

you could always try
xlApp.UserControl = True

I always have trouble working out how to deal with this one

Peter

 

[Bat17]

Dave can you post your code as it is now please

Peter

 

[Dave Eyley]

Hi Peter,

The code so far -

All the code works but a copy of Excel remains in Task List which stops the user repeating the action...

If Not IsNothing(Me!Searchstr) Then

DoCmd.SetWarnings False
DoCmd.RunSQL ("SELECT Property.Property, Space_Room_Data.Block, Space_Room_Data.Floor, Space_Room_Data.Rm_No, [Faculties and Depts].FacDiv, [Faculties and Depts].DeptName, Space_Room_Type.TypeDesc, Space_Room_Use.RmUsDesc,Space_Room_Data.Area INTO ExportTableDept FROM Space_Room_Type RIGHT JOIN (Space_Room_Use RIGHT JOIN ([Faculties and Depts] RIGHT JOIN (Property LEFT JOIN Space_Room_Data ON Property.BuildingCode = Space_Room_Data.BuildingCode) ON [Faculties and Depts].Dept_Code = Space_Room_Data.DataDept) ON Space_Room_Use.RmUs_Code = Space_Room_Data.DataUse) ON Space_Room_Type.Type_Code = Space_Room_Data.DataType WHERE " & Searchstr & " ORDER BY Property.Property, Space_Room_Data.Block, Space_Room_Data.Floor, Space_Room_Data.Rm_No;")
DoCmd.SetWarnings True
DoCmd.OutputTo acOutputTable, "ExportTableDept", acFormatXLS, "D:\PropertyExportByDept.xls", False

Dim xlApp As Excel.Application

Dim xlSheet As Object

Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.WorkBooks.Open("D:\PropertyExportByDept.xls").Sheets(1)

With xlSheet

Cells.RowHeight = 45
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With

Range("D1").Select
ActiveCell.FormulaR1C1 = "Room No"
With ActiveCell.Characters(START:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

Range("E1").Select
ActiveCell.FormulaR1C1 = "Fac/Div"
With ActiveCell.Characters(START:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

Range("F1").Select
ActiveCell.FormulaR1C1 = "Dept Name"
With ActiveCell.Characters(START:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("G1").Select
ActiveCell.FormulaR1C1 = "Room Type"
With ActiveCell.Characters(START:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
Range("H1").Select
ActiveCell.FormulaR1C1 = "Room Use"
With ActiveCell.Characters(START:=1, Length:=8).Font
.FontStyle = "Regular"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

Range("I1").Select
Columns("H:H").ColumnWidth = 25
Columns("G:G").ColumnWidth = 16.43
Columns("F:F").ColumnWidth = 33.29
Columns("E:E").ColumnWidth = 24

Cells.Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Columns("I:I").Select
Range("I11").Activate
Selection.NumberFormat = "0.00"

Range("A2").Select
Columns("A:A").ColumnWidth = 17.71
Columns("A:A").ColumnWidth = 19.29

With ActiveSheet.PageSetup
.PrintArea = "$A:$I"
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = ""
.CenterHeader = "&""Arial,Bold""&12Facilities Manager " & Chr(10) & "Faculty Space"
.RightHeader = ""
.LeftFooter = "&D"
.CenterFooter = ""
.RightFooter = ""
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 500
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.PrintErrors = xlPrintErrorsDisplayed
End With
End With
xlApp.ActiveWorkbook.Save
xlApp.ActiveWorkbook.Close
xlApp.UserControl = False
xlApp.Quit
Set xlApp = Nothing

MsgBox "The data has been exported into a spreadsheet." & Chr$(10) & Chr$(10) & "The Spreadsheet is called 'PropertyExportByDept.xls' and will be in your local D: directory"
Else
MsgBox "No Search criteria set - Go back and make selections", vbExclamation, "No Search Criteria"
End If

Dave

 

[Bat17]

try

xlSheet.Cells.RowHeight = 45
xlSheet.Rows("1:1").Select
With xlSheet.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With

xlSheet.Range("D1").Select
xlSheet.ActiveCell.FormulaR1C1 = "Room No"
With xlSheet.ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("E1").Select
xlSheet.ActiveCell.FormulaR1C1 = "Fac/Div"
With xlSheet.ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("F1").Select
xlSheet.ActiveCell.FormulaR1C1 = "Dept Name"
With xlSheet.ActiveCell.Characters(Start:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
xlSheet.Range("G1").Select
xlSheet.ActiveCell.FormulaR1C1 = "Room Type"
With xlSheet.ActiveCell.Characters(Start:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
xlSheet.Range("H1").Select
xlSheet.ActiveCell.FormulaR1C1 = "Room Use"
With xlSheet.ActiveCell.Characters(Start:=1, Length:=8).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("I1").Select
xlSheet.Columns("H:H").ColumnWidth = 25
xlSheet.Columns("G:G").ColumnWidth = 16.43
xlSheet.Columns("F:F").ColumnWidth = 33.29
xlSheet.Columns("E:E").ColumnWidth = 24

xlSheet.Cells.Select
xlSheet.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlSheet.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With xlSheet.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlSheet.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlSheet.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlSheet.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlSheet.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlSheet.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
xlSheet.Columns("I:I").Select
xlSheet.Range("I11").Activate
xlSheet.Selection.NumberFormat = "0.00"

xlSheet.Range("A2").Select
xlSheet.Columns("A:A").ColumnWidth = 17.71
xlSheet.Columns("A:A").ColumnWidth = 19.29

With xlSheet.ActiveSheet.PageSetup
.PrintArea = "$A:$I"
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = ""
.CenterHeader = "&""Arial,Bold""&12Facilities Manager " & Chr(10) & "Faculty Space"
.RightHeader = ""
.LeftFooter = "&D"
.CenterFooter = ""
.RightFooter = ""
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 500
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.PrintErrors = xlPrintErrorsDisplayed
End With

xlApp.ActiveWorkbook.Save
xlApp.ActiveWorkbook.Close
xlApp.UserControl = False
xlApp.Quit
Set xlApp = Nothing

 

[Dave Eyley]

It tripped out on - With xlSheet.Selection with the message -

Object doesn't support this Property or Method...

I don't see why not, it's only the same code in a different form, isn't it?

Dave

 

[Dave Eyley]

Peter,

I think the problem isn't with the code for formatting...
The problem starts when the data is exported using the OutputTo function...
I tried another export function which saves data in another spreadsheet unrelated to the code for formatting, then I ran the formatting code and the problem was there.
I think the OutputTo function opens the new spreadsheet, exports the data but leaves Excel open. This is what stops the formatting.
All I need to do is find a way of ensuring that the spreadsheet is close after the OutputTo function...
Sounds easy?

Dave

 

[Bat17]

Sorry, Selections and Active cells are aplication level properties not Sheet level

try

xlSheet.Cells.RowHeight = 45

With xlSheet.Rows("1:1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Font.Bold = True
End With

xlSheet.Range("D1").Select
xlApp.ActiveCell.FormulaR1C1 = "Room No"
With xlApp.ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("E1").Select
xlApp.ActiveCell.FormulaR1C1 = "Fac/Div"
With xlApp.ActiveCell.Characters(Start:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("F1").Select
xlApp.ActiveCell.FormulaR1C1 = "Dept Name"
With xlApp.ActiveCell.Characters(Start:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
xlSheet.Range("G1").Select
xlApp.ActiveCell.FormulaR1C1 = "Room Type"
With xlApp.ActiveCell.Characters(Start:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With
xlSheet.Range("H1").Select
xlApp.ActiveCell.FormulaR1C1 = "Room Use"
With xlApp.ActiveCell.Characters(Start:=1, Length:=8).Font
.FontStyle = "Regular"
.Size = 10
.StrikeThrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("I1").Select
xlSheet.Columns("H:H").ColumnWidth = 25
xlSheet.Columns("G:G").ColumnWidth = 16.43
xlSheet.Columns("F:F").ColumnWidth = 33.29
xlSheet.Columns("E:E").ColumnWidth = 24

xlSheet.Cells.Select
xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With xlApp.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With xlApp.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
xlSheet.Columns("I:I").Select
xlSheet.Range("I11").Activate
xlApp.Selection.NumberFormat = "0.00"

xlSheet.Range("A2").Select
xlSheet.Columns("A:A").ColumnWidth = 17.71
xlSheet.Columns("A:A").ColumnWidth = 19.29

With xlApp.ActiveSheet.PageSetup
.PrintArea = "$A:$I"
.PrintTitleRows = ""
.PrintTitleColumns = ""
.LeftHeader = ""
.CenterHeader = "&""Arial,Bold""&12Facilities Manager " & Chr(10) & "Faculty Space"
.RightHeader = ""
.LeftFooter = "&D"
.CenterFooter = ""
.RightFooter = ""
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 500
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
.PrintErrors = xlPrintErrorsDisplayed
End With

xlApp.ActiveWorkbook.Save
xlApp.ActiveWorkbook.Close
xlApp.UserControl = False
xlApp.Quit
Set xlApp = Nothing


Peter

 

[Dave Eyley]

Ok Peter, I'm there. I'm not sure how but it's all working properly now.
I cleaned up the code, removed any default statements and checked the syntax against your last suggestion...

Here's the code..

If Not IsNothing(Me!Searchstr) Then

DoCmd.SetWarnings False
DoCmd.RunSQL ("SELECT Property.Property, Space_Room_Data.Block, Space_Room_Data.Floor, Space_Room_Data.Rm_No, [Faculties and Depts].FacDiv, [Faculties and Depts].DeptName, Space_Room_Type.TypeDesc, Space_Room_Use.RmUsDesc,Space_Room_Data.Area INTO ExportTableDept FROM Space_Room_Type RIGHT JOIN (Space_Room_Use RIGHT JOIN ([Faculties and Depts] RIGHT JOIN (Property LEFT JOIN Space_Room_Data ON Property.BuildingCode = Space_Room_Data.BuildingCode) ON [Faculties and Depts].Dept_Code = Space_Room_Data.DataDept) ON Space_Room_Use.RmUs_Code = Space_Room_Data.DataUse) ON Space_Room_Type.Type_Code = Space_Room_Data.DataType WHERE " & Searchstr & " ORDER BY Property.Property, Space_Room_Data.Block, Space_Room_Data.Floor, Space_Room_Data.Rm_No;")
DoCmd.SetWarnings True
DoCmd.OutputTo acOutputTable, "ExportTableDept", acFormatXLS, "D:\PropertyExportByDept.xls", False

Dim xlApp As Excel.Application
Dim xlSheet As Object

Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.WorkBooks.Open("D:\PropertyExportByDept.xls").Sheets(1)

xlSheet.Cells.RowHeight = 45
With xlSheet.Rows("1:1")
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.ReadingOrder = xlContext
.Font.Bold = True
End With

xlSheet.Range("D1").Select
xlApp.ActiveCell.FormulaR1C1 = "Room No"
With xlApp.ActiveCell.Characters(START:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.ColorIndex = 1
End With

xlSheet.Range("E1").Select
xlApp.ActiveCell.FormulaR1C1 = "Fac/Div"
With xlApp.ActiveCell.Characters(START:=1, Length:=7).Font
.FontStyle = "Regular"
.Size = 10
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("F1").Select
xlApp.ActiveCell.FormulaR1C1 = "Dept Name"
With xlApp.ActiveCell.Characters(START:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("G1").Select
xlApp.ActiveCell.FormulaR1C1 = "Room Type"
With xlApp.ActiveCell.Characters(START:=1, Length:=9).Font
.FontStyle = "Regular"
.Size = 10
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("H1").Select
xlApp.ActiveCell.FormulaR1C1 = "Room Use"
With xlApp.ActiveCell.Characters(START:=1, Length:=8).Font
.FontStyle = "Regular"
.Size = 10
.Underline = xlUnderlineStyleNone
.ColorIndex = 1
End With

xlSheet.Range("I1").Select
xlSheet.Columns("H:H").ColumnWidth = 25
xlSheet.Columns("G:G").ColumnWidth = 17
xlSheet.Columns("F:F").ColumnWidth = 34
xlSheet.Columns("E:E").ColumnWidth = 25

xlSheet.Cells.Select
xlApp.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
xlApp.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With xlApp.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

With xlApp.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

xlSheet.Columns("I:I").Select
xlSheet.Range("I11").Activate
xlApp.Selection.NumberFormat = "0.00"

xlSheet.Range("A2").Select
xlSheet.Columns("A:A").ColumnWidth = 17.71
xlSheet.Columns("A:A").ColumnWidth = 19.29

With xlApp.ActiveSheet.PageSetup
.PrintArea = "$A:$I"
.CenterHeader = "&""Arial,Bold""&12Facilities Manager " & Chr(10) & "Faculty Space"
.LeftFooter = "&D"
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.FitToPagesWide = 1
.FitToPagesTall = 500
.PrintTitleRows = "$1:$1"
.PrintErrors = xlPrintErrorsDisplayed
End With

xlApp.ActiveWorkbook.Save
xlApp.ActiveWorkbook.Close
xlApp.UserControl = False
xlApp.Quit
Set xlApp = Nothing

MsgBox "The data has been exported into a spreadsheet." & Chr$(10) & Chr$(10) & "The Spreadsheet is called 'PropertyExportByDept.xls' and will be in your local D: directory"
Else
MsgBox "No Search criteria set - Go back and make selections", vbExclamation, "No Search Criteria"
End If

I am eternally grateful for your help and guidance thru this problem...

Dave