Hi all,
After much valuable help from arnelgp I now have working code to export data to Excel with all of the formatting I was looking for.
Just a couple of tweaks needed so I decided to start a new thread rather than it being lost at the end of a 3 page thread.
The below code uses 8 queries to export 7 fields data to Excel with a sheet for each query unless there is no relevant data, then it does not make a sheet for that facility. It then formats column F cells in red if the date is older than 13 days from today. It then formats the header row and the column widths. (I recorded a macro for the additional formatting and pasted the code in the code that arnelgp wrote for me).
3 small issues though.
Issue #1: this export somehow is leaving the Excel process running on my computer and if I try to run the report again (whether I delete the created exported file or not) I get an error
and the debugger highlights the line
and I have to open the task manager and end the Excel process to run the report again.
Issue #2: The data that is exported to column D which is the part number is exporting the ID of the part number rather than the actual part number. I am sure the reason is due to the relationship between the "Parts" table and the "Audit Data" table but this relationship cannot be changed or it will mess up other things in my forms and reports. Using the DoCmd.OutputTo method that the macro would use outputs the actual part numbers but using the DoCmd.TransferSpreadsheet method outputs the part number ID number instead.
Issue #3: When I open the exported Excel workbook the A1 cell of the last sheet is selected instead of the A1 cell of the first sheet in the workbook and it makes most of the other sheets be off the page to the left. This is not an issue for me but for the people I am going to send these Excel reports to are not smart enough to click the little arrows or the ... at the bottom left of the workbook to expose the other sheets and they will think they do not have anything in there for them to look at.
Here is the code:
Module:
Buttone code:
Can someone please help me edit this code to resolve the 3 issues mentioned above?
This is so close to being perfect. At least resolution to issues #1 & #2
I also attached a screenshot of a page in the Excel file to show the formatting accomplished with the above code.
Thank you very much in advance to anyone willing to help with this code.
After much valuable help from arnelgp I now have working code to export data to Excel with all of the formatting I was looking for.
Just a couple of tweaks needed so I decided to start a new thread rather than it being lost at the end of a 3 page thread.
The below code uses 8 queries to export 7 fields data to Excel with a sheet for each query unless there is no relevant data, then it does not make a sheet for that facility. It then formats column F cells in red if the date is older than 13 days from today. It then formats the header row and the column widths. (I recorded a macro for the additional formatting and pasted the code in the code that arnelgp wrote for me).
3 small issues though.
Issue #1: this export somehow is leaving the Excel process running on my computer and if I try to run the report again (whether I delete the created exported file or not) I get an error
Code:
Run-time error 91" "Object variable or With block variable not set
Code:
Selection.FormatConditions(1).StopIfTrue = True
Issue #2: The data that is exported to column D which is the part number is exporting the ID of the part number rather than the actual part number. I am sure the reason is due to the relationship between the "Parts" table and the "Audit Data" table but this relationship cannot be changed or it will mess up other things in my forms and reports. Using the DoCmd.OutputTo method that the macro would use outputs the actual part numbers but using the DoCmd.TransferSpreadsheet method outputs the part number ID number instead.
Issue #3: When I open the exported Excel workbook the A1 cell of the last sheet is selected instead of the A1 cell of the first sheet in the workbook and it makes most of the other sheets be off the page to the left. This is not an issue for me but for the people I am going to send these Excel reports to are not smart enough to click the little arrows or the ... at the bottom left of the workbook to expose the other sheets and they will think they do not have anything in there for them to look at.
Here is the code:
Module:
Code:
Public Function fnLastRow(sh As Object)
On Error Resume Next
With sh
fnLastRow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=2, _
LookIn:=5, _
SearchOrder:=1, _
SearchDirection:=2, _
MatchCase:=False).Row
End With
End Function
Buttone code:
Code:
Private Sub Waiting_on_Lab_Click()
Const FileNameBase As String = "W:\Quality-Projects\RCabler\Databases\Weekly Reports\Waiting on Visual Weekly Report [CurrentDate].xlsx"
Dim strFileName As String
strFileName = Replace(FileNameBase, "[CurrentDate]", Format$(Date, "m-dd-yyyy"))
If DCount("*", "AdvanceWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "AdvanceWaitVis", strFileName, True, "AdvanceWaitVis"
End If
If DCount("*", "ArcadiaWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "ArcadiaWaitVis", strFileName, True, "ArcadiaWaitVis"
End If
If DCount("*", "EcruWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "EcruWaitVis", strFileName, True, "EcruWaitVis"
End If
If DCount("*", "LeesportWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "LeesportWaitVis", strFileName, True, "LeesportWaitVis"
End If
If DCount("*", "RipleyWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "RipleyWaitVis", strFileName, True, "RipleyWaitVis"
End If
If DCount("*", "WanekWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WanekWaitVis", strFileName, True, "WanekWaitVis"
End If
If DCount("*", "WanvogWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WanvogWaitVis", strFileName, True, "WanvogWaitVis"
End If
If DCount("*", "WhitehallWaitVis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "WhitehallWaitVis", strFileName, True, "WhitehallWaitVis"
End If
Dim xlWB As Object
Dim xlObj As Object
Dim xlSheet As Object
Dim lngRow As Long
Set xlObj = CreateObject("Excel.Application")
Set xlWB = xlObj.Workbooks.Open(strFileName, False, False)
For Each xlSheet In xlWB.Worksheets
With xlSheet
.Activate
'lngRow = fnLastRow(xlSheet)
lngRow = .Cells(.Rows.Count, 1).End(-4162).Row 'xlUp
Debug.Print lngRow
.Range("F1:F" & lngRow).Select
xlObj.Selection.FormatConditions.Add Type:=2, Formula1:= _
"=TODAY()-F1>13"
xlObj.Selection.FormatConditions(xlObj.Selection.FormatConditions.Count).SetFirstPriority
With xlObj.Selection.FormatConditions(1).Interior
.PatternColorIndex = -4105
.Color = 255
.TintAndShade = 0
End With
xlObj.Selection.FormatConditions(1).StopIfTrue = False
Selection.FormatConditions(1).StopIfTrue = True
Range("A1:G1").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
With Selection.Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
.PatternTintAndShade = 0
End With
Columns("A:A").Select
Selection.ColumnWidth = 8.29
Columns("B:B").Select
Selection.ColumnWidth = 28.86
Columns("C:C").Select
Selection.ColumnWidth = 13.29
Columns("D:D").Select
Selection.ColumnWidth = 12.57
Columns("E:E").Select
Selection.ColumnWidth = 13.57
Columns("F:F").Select
Selection.ColumnWidth = 11
Columns("G:G").Select
Selection.ColumnWidth = 13.29
Range("A1").Select
End With
End With
Next
xlWB.Close True
Set xlSheet = Nothing
Set xlWB = Nothing
xlObj.Quit
Set xlObj = Nothing
End Sub
Can someone please help me edit this code to resolve the 3 issues mentioned above?
This is so close to being perfect. At least resolution to issues #1 & #2
I also attached a screenshot of a page in the Excel file to show the formatting accomplished with the above code.
Thank you very much in advance to anyone willing to help with this code.