Function WorkbookOpen(WorkBookName As String) As Boolean
' returns TRUE if the workbook is open
WorkbookOpen = False
On Error GoTo WorkBookNotOpen
If Len(Application.Workbooks(WorkBookName).Name) > 0 Then
WorkbookOpen = True
Exit Function
End If
WorkBookNotOpen:
End Function
Sub IMEIMCRef()
Application.DisplayAlerts = False
If Not WorkbookOpen("G:\MEDICAL SERVICES MODEL\2010 IME IMC Referrals Spreadsheet.xlsb") Then
Workbooks.Open "G:\MEDICAL SERVICES MODEL\2010 IME IMC Referrals Spreadsheet.xlsb"
newrow = Workbooks("2010 IME IMC Referrals Spreadsheet.xlsb").Sheets("Approved Referrals").Cells(Rows.Count, 1).End(xlUp).Row + 1
For k = 1 To 4
Tx = ThisWorkbook.Sheets("Tool").Range(ThisWorkbook.Sheets("Tool").Cells(1, 22 + k), ThisWorkbook.Sheets("Tool").Cells(1, 22 + k)).Value
Workbooks("2010 IME IMC Referrals Spreadsheet.xlsb").Sheets("Approved Referrals").Cells(newrow, 7 + k) = Tx
Workbooks("2010 IME IMC Referrals Spreadsheet.xlsb").Sheets("Approved Referrals").Activate
Application.CutCopyMode = False
Next k
Exit Sub
ElseIf WorkbookOpen("G:\MEDICAL SERVICES MODEL\2010 IME IMC Referrals Spreadsheet.xlsb") Then
Windows("G:\MEDICAL SERVICES MODEL\2010 IME IMC Referrals Spreadsheet.xlsb").Activate
newrow = Workbooks("2010 IME IMC Referrals Spreadsheet.xlsb").Sheets("Approved Referrals").Cells(Rows.Count, 1).End(xlUp).Row + 1
For k = 1 To 4
Tx = ThisWorkbook.Sheets("Tool").Range(ThisWorkbook.Sheets("Tool").Cells(1, 22 + k), ThisWorkbook.Sheets("Tool").Cells(1, 22 + k)).Value
Workbooks("2010 IME IMC Referrals Spreadsheet.xlsb").Sheets("Approved Referrals").Cells(newrow, 7 + k) = Tx
Workbooks("2010 IME IMC Referrals Spreadsheet.xlsb").Sheets("Approved Referrals").Activate
Application.CutCopyMode = False
Next k
End If
Application.DisplayAlerts = True
End Sub
Sub UndoArrowSearchOne()
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable4").PivotFields("Doctor").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("State/NSW-Regional/Sydney Metro").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Suburb").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Speciality").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Sub Speciality").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Permanent Impairment").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("In Current Clinical Practice ").ClearAllFilters
Application.ScreenUpdating = True
End Sub
Sub UndoArrowSearchTwo()
Application.ScreenUpdating = False
ActiveSheet.PivotTables("PivotTable4").PivotFields("Notes").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Name").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Qualifications").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Speciality ").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Agency Name").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Agency Details").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Sub Speciality ").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Suburb ").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Appointments and Availability").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("In Current Clinical Practice").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("IME/IMC").ClearAllFilters
ActiveSheet.PivotTables("PivotTable4").PivotFields("Permanent Impairment").ClearAllFilters
Application.ScreenUpdating = True
End Sub
Private Sub Workbook_Open()
Sheets("Sheet2").Activate
Sheets("Sheet2").Visible = False
Sheets("Tool").Activate
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If ActiveWorkbook.ReadOnly = True Then Exit Sub
If Sheets("Sheet2").Visible = False Then Sheets("Sheet2").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub
Really weird thing. It errors out at work, but I just tried it at home (I have the enterprise edition of Excel - not sure it that changes things) and I can create new tabs galore without errors.....