Private Sub Waiting_on_Visual_Click()
Const FileNameBase As String = "W:\Projects\User\Databases\Weekly Reports\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 = .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
.Range("A1:G1").Select
With xlObj.Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ReadingOrder = xlContext
.MergeCells = False
With .Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 11
End With
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThin
End With
.Borders(xlInsideHorizontal).LineStyle = xlNone
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.14996795556505
.PatternTintAndShade = 0
End With
End With
.Columns("A:A").Select
xlObj.Selection.ColumnWidth = 8.3
.Columns("B:B").Select
xlObj.Selection.ColumnWidth = 28.86
.Columns("C:C").Select
xlObj.Selection.ColumnWidth = 13.29
.Columns("D:D").Select
xlObj.Selection.ColumnWidth = 12.57
.Columns("E:E").Select
xlObj.Selection.ColumnWidth = 13.57
.Columns("F:F").Select
xlObj.Selection.ColumnWidth = 11
.Columns("G:G").Select
xlObj.Selection.ColumnWidth = 13.29
.Range("A1").Select
xlObj.ActiveWindow.FreezePanes = False
End With
Next
xlObj.Sheets(1).Activate
xlWB.Close True
Set xlSheet = Nothing
Set xlWB = Nothing
xlObj.Quit
Set xlObj = Nothing
End Sub