Sub Angioplasty()

Dim LastRow As Double, N As Integer
Dim MyRange As String, MyRange2 As String
Dim NameArray As Variant, SheetArray As Variant
Dim MyName As String, MySheet As String
On Error Resume Next

    Application.DisplayAlerts = False
    NameArray = Array("CRN", "NAME", "SPECIALTY", "SPEC.CODE", "HOSP", "CONSULTANT", "DATE ON LIST", "PROCEDURE", "DATE OFFERED")
    
    For N = 0 To 8
        MyName = NameArray(N)
        Cells(1, N + 1).Formula = MyName
    Next N
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row

    Range("F1").EntireColumn.Insert
    Range("F1").Formula = "HOSP/SPEC"
    With Range("F2:F" & LastRow)
        .FormulaR1C1 = "=CONCATENATE(RC[-1],RC[-2])"
        .Formula = .Value
    End With

    Range("D2:D" & LastRow).Replace what:="A2", replacement:=""
    Range("D2:D" & LastRow).SpecialCells(xlCellTypeConstants).EntireRow.Delete
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("D2:D" & LastRow).Formula = "A2"

    Range("N1").EntireColumn.Insert
    With Range("N2:N" & LastRow)
        .FormulaR1C1 = "= LEFT(RC[-5],2)"
        .Formula = .Value
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
        .Replace "AP", ""
        .SpecialCells(xlCellTypeConstants).EntireRow.Delete
    End With
    
    LastRow = Range("A" & Rows.Count).End(xlUp).Row
    
    Range("H1").EntireColumn.Insert
    Range("H1").Formula = "18 Week" & Chr(10) & "Failure Date" & Chr(10) & "(+126 days)"
    
    With Range("H2:H" & LastRow)
        .FormulaR1C1 = "=RC[1]+126"
        .NumberFormat = "0"
        .Formula = .Value
        .NumberFormat = "dd/mm/yyyy"
    End With

    Workbooks.Open Filename:="H:\excel\FY0405\GUARPATS\service groups.xls"
    Workbooks("Wait1").Activate
    Range("F2:F" & LastRow).Select
    Application****n Macro:="'Service Groups.xls'!NAMESPEC"


    Cells(1, 1).Sort key1:=Cells(2, 5), Header:=xlYes
    Cells(1, 1).Sort key1:=Cells(2, 8), Header:=xlYes

    Cells(1, 13).Formula = Now
    Cells(2, 13).FormulaR1C1 = "= MONTH(R[-1]C[0])"
    Cells(2, 16).FormulaR1C1 = "= YEAR(R[-1]C[-3])"
    
    MyRange = "L2:L" & LastRow
    With Range("L2:L" & LastRow)
        .FormulaR1C1 = "= MONTH(RC[-4])"
        .Formula = .Value
        .NumberFormat = "0"
    End With
    
    Range("M2:M" & LastRow).Formula = Range("M2").Value
    
    With Range("N2:N" & LastRow)
        .FormulaR1C1 = "= (Rc[-2]-rc[-1])"
        .Formula = .Value
    End With
    
    With Range("O2:O" & LastRow)
        .FormulaR1C1 = "= year(rc[-7])"
        .Formula = .Value
    End With

    Range("P2:P" & LastRow).Formula = Range("P2").Value
    
    With Range("Q2:Q" & LastRow)
        .FormulaR1C1 = "= (rc[-3])+(12*(rc[-2]-rc[-1]))"
        .Formula = .Value
    End With

    'provide a set of new sheets to put the data in
    Call NewSheets
    'sorts the data into the relevant sheet
    Call SelWait

    SheetArray = Array("9 Mnth", "8 Mnth", "7 Mnth", "6 Mnth", "5 Mnth", "4 Mnth", "3 Mnth", "2 Mnth", "1 Mnth", "0 Mnth")
    
    For N = 0 To 9
        Select Case N
            Case 0 To 4
                MySheet = SheetArray(N)
                Worksheets(MySheet).Delete
            Case Else
                MySheet = SheetArray(N)
                Worksheets(MySheet).Activate
                'put a border around the data
                Call Border
                'sort out the headers
                Call Tidy
                Range("B2:J2").Replace "Patients on the True Waiting List who will fail the Guarentee as at", _
                    "Patients on the True Waiting List For Angioplasty who will fail the Guarantee in" _
                , xlPart
                Range("F1").EntireColumn.Insert
            With Range("F5:F" & LastRow)
                .FormulaR1C1 = "=LEFT(RC[1],1)"
                .Formula = .Value
            End With
            For Each cell In Range("G5:G" & LastRow)
                If Not cell.Formula = "Dr Gray's" And cell.Formula <> "" Then
                    cell.Formula = Right(cell.Formula, Len(cell.Formula) - 1)
                End If
            Next cell
            Range("F4").Formula = "Service"
            Range("G4").Formula = "Group"
        End Select
    Next N
    
    On Error GoTo 0
End Sub