How do you find links and remove them?
David lang
links and excel puts up a dialog box asking if I want to refresh them.
I don't since the only file I know I open would contain only custom
chart formats (probably xlusrgal.xls). How do I find out
1. what file is being opened?
2. Where are the links in that file?
3. How to remove them?
Dave Lang
John Green
Hi Dave,
You can see what files a workbook is linked to using Edit|Links, but
finding the references and removing them is another thing.
Download Bill Manville's free utility - FindLink.xla - from Stephen
Bullen's site - www.bmsltd.co.uk
HTH,
John Green (Excel MVP)
Sydney
Australia
Please post all replies to NewsGroups
In article <396E7F73...@home.com>, David lang wrote:
> From: David lang <dav...@home.com>
> Newsgroups: microsoft.public.excel.programming
> Subject: How do you find links and remove them?
> Date: Fri, 14 Jul 2000 02:42:16 GMT
ast...@pipeline.com
jgr...@enternet.com.au wrote:
> You can see what files a workbook is linked to using Edit|Links, but
> finding the references and removing them is another thing.
In article <VA.0000096d.0048fd3b@t8000>,
jgr...@enternet.com.au wrote:
> You can see what files a workbook is linked to using Edit|Links, but
> finding the references and removing them is another thing.
I have a couple workbooks that have what I call "phantom" links. When I
open the workbook excel can't find an apparently referenced file and
pops up the open file dialog. There are no references to the file in
the workbook and Edit|Links doesn't show it either. Findlinks.xla
doesn't find it.
Anybody know how I can get rid of this? Thanks.
Sent via Deja.com http://www.deja.com/
Before you buy.
David McRitchie
See what other files are open, started up from within XLSTART
or your Alternate file -- hopefully blank in tools,general, alternate startup
Try turning off all Add-ins
Perhaps you have toolbars converted from XL95, check
added menu items.
HTH,
David McRitchie, Microsoft MVP - Excel (site changed 2000-04-15)
My Excel Macros: http://www.geocities.com/davemcritchie/excel/excel.htm
<ast...@pipeline.com> wrote in message news:8kv8jt$ru0$1...@nnrp1.deja.com...
Art Steinmetz
Thanks for the suggestions, all. Nothing worked but your ideas got me
thinking more about the problem and I solved it.
there were extra-worksheet references present but since Excel couldn't
find the reference the values of the cells that had references didn't
change - and no error indication is given (i.e. #REF#). These
references were a one-shot import anyway and weren't supposed to be
dynamic so no impact on results was felt. When I made a dummy worksheet
for excel to find the values were updated and replaced with the nonsense
values in the dummy. This made 'em easier to find.
-- Art
Lesson: The link auditing features don't work if excel can't find the
external reference in the first place.
Gary Brown
will also create hyperlinks to those cells to make it very easy to locate
them. The hyperlinks won't go to a hidden worksheet, however.
HTH,
Gary Brown
Kinneson Consulting
'Code starts here
Option Explicit
Option Compare Text
'Version 1a: 01/2000 - ranges included in search
'Version 2.0: 03/21/2000 - names of sheets in workbook included in search
'Version 3.0: 04/20/2000 - DrawingObjects in workbook included in search
' Note: V3.0 DrawingObjects methodology strongly influenced by
' Bill Manville's FindLink.xla
'Version 3.1: 06/06/2000 for recognition of ErrorTypes
'Version 3.2: 06/14/2000 - account for mis-formatting when there are
' hidden sheets
'Version 3.3: 07/06/2000 - add hyperlink to appropriate addresses
'
Const constVersion = "3.3"
'=========================================================
Public Sub SearchFinder()
On Error Resume Next
'Purpose of this VBA program is to find and list all searched for items
'in a Workbook
'
'Note: calls funcErrorType
'
'Ctrl-Shift-S to run this macro
' For use with EXCEL 97 or higher
'
Dim aryHiddensheets()
Dim bTrueFalse1 As Boolean, bTrueFalse As Boolean
Dim iRow As Double, iColumn As Double, dblLastRow
Dim iFormulaCount As Double, iTextValuesCount As Double
Dim i As Integer, iErrorTest As Integer
Dim x As Integer, y As Integer, iWorksheets As Integer
Dim nName As Name
Dim objOutputArea As Object, objCell As Object
Dim objRangeWithTextAndValues As Object
Dim objRangeWithFormulas As Object, obj As Object
Dim strInputQuestion As String, strResultsTableName As String
Dim strWorksheetName As String, strWorksheetType As String
Dim varAnswer As Variant, varCellFormula As Variant
Dim varLookFor As Variant, varLookFor_Original As Variant
Dim varErrorTest As Variant
strResultsTableName = "Results_Table"
strInputQuestion = "What are you Looking for?" & vbCr & "To find
references to other spreadsheets, type " & Chr(34) & _
".xls" & Chr(34) & vbCr & _
"To review other " & Chr(39) & "Errors" & Chr(39) & ", try:" & _
vbCr & "#N/A or #NAME? or #REF! or #VALUE! or #DIV/0! or #NULL! or
#NUM!"
varLookFor_Original = Application.InputBox(strInputQuestion, _
"Search and List - V. " & constVersion, ".xls")
varLookFor = UCase(varLookFor_Original)
If varLookFor_Original = False Then
Exit Sub
End If
strInputQuestion = "You have not entered anything." & Chr(10) & Chr(10)
& _
"Note: Continuing will list ALL information in ALL worksheets in the
workbook." & _
Chr(10) & Chr(10) & _
"Press Ctrl-Break at any time to break out of this program." & _
Chr(10) & Chr(10) & _
"Do you wish to continue?"
If Len(varLookFor) = 0 Then
varAnswer = MsgBox(strInputQuestion, vbInformation + vbYesNo +
vbDefaultButton2, _
"This could be a VERY lengthy process...!!!")
If varAnswer = vbNo Then
Exit Sub
End If
End If
'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count
'redim array
ReDim aryHiddensheets(1 To iWorksheets)
'put hidden sheets in an array, then unhide the sheets
For x = 1 To iWorksheets
If Worksheets(x).Visible = False Then
aryHiddensheets(x) = Worksheets(x).Name
Worksheets(x).Visible = True
End If
Next
'Check for duplicate Worksheet name
i = ActiveWorkbook.Sheets.Count
For x = 1 To i
If Windows.Count = 0 Then Exit Sub
If UCase(Worksheets(x).Name) = UCase(strResultsTableName) Then
Worksheets(x).Activate
If Err.Number = 9 Then
Exit For
End If
Application.DisplayAlerts = False 'turn warning messages
off
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True 'turn warning messages
on
'Exit Sub
End If
Next
'Add new worksheet at end of workbook
' where results will be located
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
'Name the new worksheet and set up Titles
ActiveWorkbook.ActiveSheet.Name = strResultsTableName
ActiveWorkbook.ActiveSheet.Range("A1").Value = "Worksheet"
ActiveWorkbook.ActiveSheet.Range("B1").Value = "Address"
ActiveWorkbook.ActiveSheet.Range("C1").Value = "Type"
ActiveWorkbook.ActiveSheet.Range("D1").Value = "Results Found"
ActiveWorkbook.ActiveSheet.Range("E1").Value = "Value"
'Count number of worksheets in workbook
iWorksheets = ActiveWorkbook.Sheets.Count
'Initialize row and column counts for putting info into
StrResultstablename sheet
iRow = 1
iColumn = 0
'Check Sheet names
For x = 1 To iWorksheets
Sheets(x).Activate
strWorksheetName = ActiveSheet.Name
strWorksheetType = UCase(TypeName(ActiveSheet))
If UCase(ActiveSheet.Name) = UCase(strResultsTableName) Then
Exit For
End If
'check to see if a match exists for sheet names
Set objOutputArea =
ActiveWorkbook.Sheets(strResultsTableName).Range("A1")
With objOutputArea
If InStr(UCase(strWorksheetName), varLookFor) <> 0 Then
'put information into StrResultstablename worksheet
.Offset(iRow, iColumn) = " " & ActiveSheet.Name
.Offset(iRow, iColumn + 1) = ""
.Hyperlinks.Add anchor:=.Offset(iRow, iColumn), _
Address:="", SubAddress:=Chr(39) & ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "W"
.Offset(iRow, iColumn + 3) = " "
Select Case strWorksheetType
Case "CHART"
.Offset(iRow, iColumn + 4) = " Note: CHART"
Case "WORKSHEET"
.Offset(iRow, iColumn + 4) = " Note: WORKSHEET"
Case "DIALOGSHEET"
.Offset(iRow, iColumn + 4) = " Note: DialogSheet"
Case Else
.Offset(iRow, iColumn + 4) = " Note: Type Unknown"
End Select
iRow = iRow + 1
End If
End With
If iRow = 65536 Then
iColumn = iColumn + 5
iRow = 1
End If
Next x
'Go through one Worksheet at a time
For x = 1 To iWorksheets
'Go to Next Worksheet
Worksheets(x).Activate
'Initialize formula and text/value count variables
iFormulaCount = 0
iTextValuesCount = 0
If ActiveWorkbook.ActiveSheet.Name <> strResultsTableName Then
'Identify the cells with formulas and text/values in them
Set objRangeWithTextAndValues = Nothing
Set objRangeWithFormulas = Nothing
'Establish cells with formulas and text/values in them
On Error Resume Next
Set objRangeWithTextAndValues =
ActiveSheet.Cells.SpecialCells(xlTextValues)
Set objRangeWithFormulas =
ActiveSheet.Cells.SpecialCells(xlFormulas)
iFormulaCount = objRangeWithFormulas.Count
iTextValuesCount = objRangeWithTextAndValues.Count
'if there is text
If iTextValuesCount <> 0 Then
'Process each cell with a value or text in it
Set objOutputArea =
ActiveWorkbook.Sheets(strResultsTableName).Range("A1")
For Each objCell In objRangeWithTextAndValues
With objOutputArea
'check to see if a match exists
If InStr(UCase(objCell.Formula), varLookFor) <> 0
Then
'put information into StrResultstablename
worksheet
.Offset(iRow, iColumn) = " " & ActiveSheet.Name
.Offset(iRow, iColumn + 1) = _
objCell.AddressLocal(rowabsolute:=False, _
columnabsolute:=False)
.Hyperlinks.Add anchor:=.Offset(iRow, iColumn +
1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!" &
objCell.AddressLocal(rowabsolute:=False, _
columnabsolute:=False)
.Offset(iRow, iColumn + 2) = "V"
.Offset(iRow, iColumn + 3) = " " &
objCell.Formula
.Offset(iRow, iColumn + 4) = " " & objCell.Value
iRow = iRow + 1
End If
End With
If iRow = 65536 Then
iColumn = iColumn + 5
iRow = 1
End If
Next objCell
End If
'if there are formulas
If iFormulaCount <> 0 Then
'Process each cell with a value or text in it
Set objOutputArea =
ActiveWorkbook.Sheets(strResultsTableName).Range("A1")
For Each objCell In objRangeWithFormulas
With objOutputArea
'check to see if a match exists
' capture numeric, alpha values and errors from
formulas
varErrorTest = funcErrorType(objCell.Value)
iErrorTest = 0
If InStr(UCase(objCell.Formula), varLookFor) <> 0
Then iErrorTest = 1
If InStr(UCase(varErrorTest), varLookFor) <> 0 Then
iErrorTest = 2
If Len(varErrorTest) = 0 Then
If InStr(UCase(objCell.Value), varLookFor) <> 0
Then
iErrorTest = 1
End If
End If
If InStr(UCase(objCell.Value), varLookFor) <> 0 Then
If IsError(InStr(UCase(objCell.Value),
varLookFor)) Then
If iErrorTest <> 1 And iErrorTest <> 2 Then
iErrorTest = 0
End If
End If
If iErrorTest <> 0 Then
'put information into StrResultsTableName
worksheet
.Offset(iRow, iColumn) = " " & ActiveSheet.Name
.Offset(iRow, iColumn + 1) = _
objCell.AddressLocal(rowabsolute:=False, _
columnabsolute:=False)
.Hyperlinks.Add anchor:=.Offset(iRow, iColumn +
1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!" &
objCell.AddressLocal(rowabsolute:=False, _
columnabsolute:=False)
.Offset(iRow, iColumn + 2) = "F"
.Offset(iRow, iColumn + 3) = " " &
objCell.Formula
If UCase(varErrorTest) = "" Then
.Offset(iRow, iColumn + 4) = " " &
objCell.Value
Else
.Offset(iRow, iColumn + 4) = " " &
varErrorTest
End If
iRow = iRow + 1
End If
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
varErrorTest = ""
Next objCell
End If
End If
If ActiveWorkbook.ActiveSheet.Name <> strResultsTableName Then
For Each obj In ActiveSheet.DrawingObjects
' any drawing object
If InStr(obj.OnAction, varLookFor) > 0 Then
With objOutputArea
'check to see if a match exists
'put information into StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " & ActiveSheet.Name
.Offset(iRow, iColumn + 1) = " On Action of " &
obj.Name
.Hyperlinks.Add anchor:=.Offset(iRow, iColumn + 1),
_
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = " " & obj.OnAction
.Offset(iRow, iColumn + 4) = ""
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
' some drawing objects have formula properties
bTrueFalse = False 'Have not reviewed this object yet
Select Case TypeName(obj)
Case "TextBox", "Picture", "Button", "Label"
bTrueFalse = False
If TypeName(obj) <> "Label" Then
If InStr(obj.Formula, varLookFor) > 0 Then
bTrueFalse = True
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) = " Formula
in " & TypeName(obj) & " - " & obj.Name
.Hyperlinks.Add anchor:=.Offset(iRow,
iColumn + 1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = " " &
obj.Formula
.Offset(iRow, iColumn + 4) = " " &
obj.Value
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
End If
' check drawing object name
If bTrueFalse = False Then
If InStr(obj.Name, varLookFor) > 0 Then
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) =
TypeName(obj)
.Hyperlinks.Add anchor:=.Offset(iRow,
iColumn + 1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = " " &
obj.Name
.Offset(iRow, iColumn + 4) = ""
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
End If
Case "OLEObject"
bTrueFalse = True
bTrueFalse1 = False ' OLEType not a link
If obj.OLEType = xlOLELink Then ' Linked
Object
If Val(Application.Version) >= 8 Then
' in Excel 8 we can check the source of the link
If InStr(obj.SourceName, varLookFor) > 0
Then
bTrueFalse1 = True 'OLEType is a link
with VarLookFor
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) = " " &
obj.Name
.Hyperlinks.Add
anchor:=.Offset(iRow, iColumn + 1), _
Address:="", SubAddress:=Chr(39)
& ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = " " &
obj.SourceName
.Offset(iRow, iColumn + 4) = ""
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
End If
Else
' check name in Embedded Objects and Linked
Objects if
' it was not checked in the above test
If bTrueFalse1 = False Then
If InStr(obj.Name, varLookFor) > 0 Then
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) = " In
name of"
.Hyperlinks.Add
anchor:=.Offset(iRow, iColumn + 1), _
Address:="", SubAddress:=Chr(39)
& ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = " " &
obj.Name
.Offset(iRow, iColumn + 4) = ""
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
End If
End If
Case "DropDown", "ListBox"
bTrueFalse = True
bTrueFalse1 = False
If InStr(obj.LinkedCell, varLookFor) > 0 Then
bTrueFalse1 = True
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) =
TypeName(obj)
.Hyperlinks.Add anchor:=.Offset(iRow,
iColumn + 1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = "
LinkedCell: " & obj.LinkedCell
.Offset(iRow, iColumn + 4) = " " &
obj.Name
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
If bTrueFalse1 = False Then
If InStr(obj.Name, varLookFor) > 0 Then
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) =
TypeName(obj)
.Hyperlinks.Add anchor:=.Offset(iRow,
iColumn + 1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = " " &
obj.Name
.Offset(iRow, iColumn + 4) = ""
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
End If
If InStr(obj.ListFillRange, varLookFor) > 0 Then
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) =
TypeName(obj)
.Hyperlinks.Add anchor:=.Offset(iRow,
iColumn + 1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = "
ListFillRange: " & obj.ListFillRange
.Offset(iRow, iColumn + 4) = " " &
obj.Name
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
Case Else
If bTrueFalse = False Then
If InStr(obj.Name, varLookFor) > 0 Then
With objOutputArea
'check to see if a match exists
'put information into
StrResultsTableName worksheet
.Offset(iRow, iColumn) = " " &
ActiveSheet.Name
.Offset(iRow, iColumn + 1) =
TypeName(obj)
.Hyperlinks.Add anchor:=.Offset(iRow,
iColumn + 1), _
Address:="", SubAddress:=Chr(39) &
ActiveSheet.Name & _
Chr(39) & "!A1"
.Offset(iRow, iColumn + 2) = "O"
.Offset(iRow, iColumn + 3) = " " &
obj.Name
.Offset(iRow, iColumn + 4) = ""
iRow = iRow + 1
End With
If iRow = 65536 Then
iColumn = iColumn + 7
iRow = 1
End If
End If
End If
End Select
Next
End If
Next x
'evaluate all ranges in the workbook
For Each nName In ActiveWorkbook.Names
With objOutputArea
bTrueFalse1 = False
If InStr(UCase(nName.Name), varLookFor) <> 0 Then
bTrueFalse1 = True
'put information into StrResultstablename worksheet
.Offset(iRow, iColumn) = " " & nName.Name
.Offset(iRow, iColumn + 1) = ""
.Offset(iRow, iColumn + 2) = "R"
.Offset(iRow, iColumn + 3) = " " & nName.RefersTo
.Offset(iRow, iColumn + 4) = " " & nName.Value
iRow = iRow + 1
End If
If Not bTrueFalse1 Then
If InStr(UCase(nName.RefersTo), varLookFor) <> 0 Then
'put information into StrResultstablename worksheet
.Offset(iRow, iColumn) = " " & nName.Name
.Offset(iRow, iColumn + 1) = ""
.Offset(iRow, iColumn + 2) = "R"
.Offset(iRow, iColumn + 3) = " " & nName.RefersTo
.Offset(iRow, iColumn + 4) = " " & nName.Value
iRow = iRow + 1
End If
End If
End With
Next
'Release all variables from memory
Set objRangeWithTextAndValues = Nothing
Set varCellFormula = Nothing
Set varAnswer = Nothing
Set objOutputArea = Nothing
Set objCell = Nothing
Set objRangeWithTextAndValues = Nothing
'start formatting output
Columns("A:E").Select
Columns("A:E").EntireColumn.AutoFit
'creating comment
With Range("C1")
.Select
.AddComment
.Comment.Shape.Select True
.Comment.Text Text:= _
"Note:" & vbLf & "(F)ormula" & vbLf & "(O)bject" & vbLf & _
"(R)ange" & vbLf & "(V)alue/Text" & vbLf & "(W)orksheet"
Selection.ShapeRange.ScaleHeight 1.74, msoFalse, msoScaleFromTopLeft
.Comment.Visible = False
End With
'continue formatting output
Columns("A:A").Select
If Selection.ColumnWidth > 50 Then
Selection.ColumnWidth = 50
End If
Columns("D:D").Select
If Selection.ColumnWidth > 50 Then
Selection.ColumnWidth = 50
End If
Columns("E:E").Select
If Selection.ColumnWidth > 50 Then
Selection.ColumnWidth = 50
End If
Columns("A:A,D:E").Select
With Selection
.WrapText = True
End With
Rows("1:1").Select
With Selection
.HorizontalAlignment = xlCenter
.WrapText = True
End With
With Selection.Font
.Underline = xlUnderlineStyleSingleAccounting
End With
Range("A2").Select
ActiveWindow.FreezePanes = True
Columns("B:C").Select
With Selection
.HorizontalAlignment = xlCenter
End With
Range("D1").Select
With Selection
.HorizontalAlignment = xlLeft
End With
Range("A:E").Select
With Selection
.VerticalAlignment = xlTop
End With
Range("A1:A1").Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("B2")
_
, Order2:=xlAscending, Key3:=Range("C2"), Order3:=xlAscending,
Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom
Rows("1:1").Select
Selection.Insert Shift:=xlDown
dblLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
dblLastRow = dblLastRow - 2
ActiveWorkbook.ActiveSheet.Range("A1").WrapText = False
ActiveWorkbook.ActiveSheet.Range("A1").Value = _
dblLastRow & " hit(s) on Search Criteria: " &
varLookFor_Original
Selection.Font.Bold = True
Range("A2").Select
'formatting printing
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
End With
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.5)
.BottomMargin = Application.InchesToPoints(0.5)
.HeaderMargin = Application.InchesToPoints(0.25)
.FooterMargin = Application.InchesToPoints(0.25)
.Orientation = xlLandscape
.Order = xlOverThenDown
.Zoom = 80
.LeftHeader = "&""Tms Rmn,Bold""&U&A"
.LeftFooter = "Printed: &D - &T"
.CenterFooter = "Page &P of &N"
.RightFooter = "&F-&A"
.PrintGridlines = True
End With
ActiveWindow.Zoom = 75
're-hide previously hidden sheets
On Error Resume Next
y = UBound(aryHiddensheets)
For x = 1 To y
Worksheets(aryHiddensheets(x)).Visible = False
Next
'Error Handling routines - currently not used
Exit_Err_Handler1:
Exit Sub
Err_Handler1:
MsgBox Err.Description & " - (Error # " & Err.Number & ")"
Resume Exit_Err_Handler1
End Sub
'================================================
Public Function funcErrorType(varTest As Variant) As String
Dim strAnswer As String
Select Case varTest
Case CVErr(xlErrDiv0) '2007
strAnswer = "#Div/0!"
Case CVErr(xlErrNA) '2042
strAnswer = "#N/A"
Case CVErr(xlErrName) '2029
strAnswer = "#Name?"
Case CVErr(xlErrNull) '2000
strAnswer = "#Null!"
Case CVErr(xlErrNum) '2036
strAnswer = "#Num!"
Case CVErr(xlErrRef) '2023
strAnswer = "#Ref!"
Case CVErr(xlErrValue) '2015
strAnswer = "#Value!"
Case Else
strAnswer = "Unknown"
End Select
funcErrorType = strAnswer
End Function
'================================================
"Art Steinmetz" <ast...@pipeline.com> wrote in message
news:8l2bmu$7il$1...@nnrp1.deja.com...