Sub Macro1()
'
' Macro1 Macro
' Macro recorded 8/1/2007 by Alfred Sumrall
'
' Keyboard Shortcut: Ctrl+Shift+I
'
Sheets("BY FAC & UNIT").Select
Range("C2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-2],"" -- "",RC[-1])"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C2559")
Range("C2:C2559").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Cells.Select
Application.CutCopyMode = False
With Selection
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Cells.Select
Cells.EntireColumn.AutoFit
Range("C1").Select
ActiveCell.FormulaR1C1 = "Facility & Nursing Unit"
Columns("A:C").Select
Range("C1").Activate
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Columns("C:C").Select
Selection.AutoFilter
Columns("C:C").Select
Selection.EntireColumn.Hidden = True
Columns("D:D").Select
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Selection.ColumnWidth = 45
ActiveWindow.ScrollColumn = 1
With Selection
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlBottom
.WrapText = True
.Orientation = 0
.IndentLevel = 0
.ShrinkToFit = False
.MergeCells = False
End With
Columns("E:K").Select
With Selection
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.ShrinkToFit = False
.MergeCells = False
End With
Range("F1:K1").Select
Range("K1").Activate
Selection.Replace What:="-", Replacement:="/1/", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.NumberFormat = "mmm-yy"
Range("A1:K1").Select
Range("K1").Activate
Selection.Font.Bold = True
Selection.Interior.ColorIndex = 36
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
Columns("F:K").Select
Range("K1").Activate
Selection.ColumnWidth = 11
Columns("E:E").Select
Selection.ColumnWidth = 12
ActiveWindow.ScrollColumn = 1
Range("E2:K2559").Select
Selection.FormatConditions.Delete
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="0", Formula2:="0.8499"
With Selection.FormatConditions(1).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(1).Interior.ColorIndex = 3
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="0.85", Formula2:="0.8999"
With Selection.FormatConditions(2).Font
.Bold = True
.Italic = False
.ColorIndex = 1
End With
Selection.FormatConditions(2).Interior.ColorIndex = 6
Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlBetween, _
Formula1:="0.9", Formula2:="1"
With Selection.FormatConditions(3).Font
.Bold = True
.Italic = False
.ColorIndex = 2
End With
Selection.FormatConditions(3).Interior.ColorIndex = 10
ActiveWindow.ScrollColumn = 1
Range("E2").Select
ActiveWindow.FreezePanes = True
Range("A1:K2559").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
Range("E2").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$1"
.PrintTitleColumns = ""
End With
ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = _
"&""Arial,Bold""&12Methodist Le Bonheur Healthcare" & Chr(10) & "The Joint Commission Database&""Arial,Regular""&10" & Chr(10) & "&""Arial,Bold Italic""&12Level of Analysis: By Facility && Nursing Unit"
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = "&D" & Chr(10) & "Page &P of &N"
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(1.25)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 5
Cells.Select
Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("A2").Select
End Sub