Option Compare Database
Public Function WaitVis()
Const FileNameBase As String = "\\site.com\Designated Folders\Weekly Reports\Waiting on Visual Weekly Report [CurrentDate].xlsx"
Dim strFileName As String
strFileName = Replace(FileNameBase, "[CurrentDate]", Format$(Date, "m-dd-yyyy"))
If DCount("*", "qry_advancewaitvis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_advancewaitvis", strFileName, True, "Advance"
End If
If DCount("*", "qry_arcadiawaitvis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_arcadiawaitvis", strFileName, True, "Arcadia"
End If
If DCount("*", "qry_ecruwaitvis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_ecruwaitvis", strFileName, True, "Ecru"
End If
If DCount("*", "qry_leesportwaitvis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_leesportwaitvis", strFileName, True, "Leesport"
End If
If DCount("*", "qry_ripleywaitvis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_ripleywaitvis", strFileName, True, "Ripley"
End If
If DCount("*", "qry_wanekwaitvis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_wanekwaitvis", strFileName, True, "Wanek"
End If
If DCount("*", "qry_whitehallwaitvis") > 0 Then
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_whitehallwaitvis", strFileName, True, "Whitehall"
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 Function