error '9' en tiempo de ejecucion, subindice fuera de intervalo

estimados amigos cuando trabajo con estos codigos en un complemento que
se llama dataform2.xla. trabajan muy bien, pero al copiar los modulos y
userfom a un archivo que se llama centrales.xls (lo que hago es
exportar y luego importar) me arroja el error '9' en tiempo de
ejecución. pueden ayudarme en donde esta el error. Gracias Isaac


el codigo es este (esta un poco grande :( )

Private Sub UserForm_Initialize()
'This sub is executed before FormMain is displayed
Dim i As Long, j As Long, k As Long
Dim CurrentFrame As Frame
Dim VerticalPosition As Long
Dim NewLabel As Control
Dim NewControl As Control
Dim Options As Range
Dim ctl As Control
Dim ModifiedName As String
Dim ComboBoxOptions As Variant

'Get the text items
Call TranslateText(LANGUAGE)

Me.Width = UserWidth() 'Function looks for DF_WIDTH name
Me.Height = UserHeight() 'Function looks for DF_HEIGHT name

'If DF_WIDTH and/or DF_HEIGHT range names exist, change the form
dimensions
If Me.Width <> 270 Or Me.Height <> 240 Then '270 and 240 are the
default dimensions
MultiPage1.Width = Me.Width - 20
MultiPage1.Height = Me.Height - 54
HelpButton.Top = Me.Height - 42
LabelRecNum.Top = Me.Height - 38
UndoButton.Top = Me.Height - 42
CloseButton.Top = Me.Height - 42
ScrollBar1.Top = MultiPage1.Height - 36
NewButton.Left = MultiPage1.Width - 60
InsertButton.Left = MultiPage1.Width - 60
DeleteButton.Left = MultiPage1.Width - 60
FindPreviousButton.Left = MultiPage1.Width - 60
FindNextButton.Left = MultiPage1.Width - 60
ClearCriteriaButton.Left = MultiPage1.Width - 60
TipsButton.Left = MultiPage1.Width - 60
CloseButton.Left = Me.Width - 60
UndoButton.Left = CloseButton.Left - 66
Frame1.Width = MultiPage1.Width - 74
Frame1.Height = MultiPage1.Height - 48
Frame2.Width = MultiPage1.Width - 74
Frame2.Height = MultiPage1.Height - 48
ScrollBar1.Width = Frame1.Width
End If

'Set the caption for the form
Me.Caption = APPNAME

'Determine the offsets (important if the database does not begin in
A1)
RowOffset = DatabaseRange.Rows(1).Row
ColumnOffset = DatabaseRange.Columns(1).Column - 1

'Determine the size of the database
RecordCount = DatabaseRange.Rows.Count - 1 'First row is assumed to
be labels
FieldCount = DatabaseRange.Columns.Count

'Set up the Labels and TextBoxes/ComboBoxes for the fields
dynamically
For i = 1 To 2
'First time thru, do Page1 (Data entry, Frame1 on Page1 of the
MultiPage control)
'Second time thru do Page2 (Criteria, Frame2 on Page2 of the
MultiPage control)
If i = 1 Then Set CurrentFrame = Frame1 Else Set CurrentFrame Frame2
VerticalPosition = 5 'controls the vertical placement of the
controls
For j = 1 To FieldCount
'Add a label
Set NewLabel = CurrentFrame.Controls.Add("forms.label.1")
With NewLabel
.Top = VerticalPosition + 3
.Left = 4
.Width = 60
.TextAlign = 3
.WordWrap = False
.Caption Application.WorksheetFunction.Clean(DatabaseRange.Cells(1, j))
.Height = 16
.Font.Size = 8
End With
'Is a Name defined with an array of choices?
ModifiedName = Application.Substitute(NewLabel.Caption, "
", "_")

If NameHasData(ModifiedName) Then
'Add a ComboBox
Set NewControl CurrentFrame.Controls.Add("forms.combobox.1")
ComboBoxOptions UNIQUEITEMS(Worksheets(Range(ModifiedName).Parent.Name).Range(ModifiedName))
If IsArray(ComboBoxOptions) Then NewControl.List ComboBoxOptions
Else
'Add a TextBox
Set NewControl CurrentFrame.Controls.Add("forms.textbox.1")
End If
With NewControl
.Top = VerticalPosition
.Left = 66
'Adjust the width, based on whether scroll bar appears
in the frame
If FieldCount * 18 > Frame1.Height Then
.Width = Me.Frame1.Width - 85 'scroll bar present
Else
.Width = Me.Frame1.Width - 72
End If
.Height = 16
.Font.Size = 8
End With
VerticalPosition = VerticalPosition + 18 'increment
Next j

'Determine how much to scroll the frame, based on the number of
fields
CurrentFrame.ScrollHeight = (FieldCount * 18) + 5
Next i

'Display the record in the row of the active cell
CurrentRecord = ActiveCell.Row - DatabaseRange.Rows(1).Row
If CurrentRecord = 0 Then CurrentRecord = 1 'Title row is selected

'Make sure Page1 of the MultiPage control is displayed
MultiPage1.Value = 0
MultiPage1_Change ' Call the sub that's executed when the page is
changed

'Set up the record scroll bar
'ScrollBar1 is always in sync with the CurrentRecord
With ScrollBar1
.Min = 1
.Max = RecordCount
.Value = CurrentRecord
End With

'Update the form
Call UpdateForm

'Set the focus to the first field
On Error Resume Next
With Frame1.Controls(1)
.SelStart = 0
.SelLength = Len(Frame1.Controls(1).Text)
.SetFocus
End With

ScrollBarClicked = True
Range(Cells(CurrentRecord + RowOffset, 1 + ColumnOffset),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Select
End Sub

Private Sub UndoButton_Click()
'Executed when the UndoButton is clicked
'The UndoButton is visible only when something
'can be udone (Insert a record, Delete a record, or New record)
'The UndoButton caption describes what will be undone

Dim i As Long
Dim OldRec As Long
Dim CurrentRow As Long

OldRec = CurrentRecord
Select Case UndoButton.Caption
Case Text(15) '"Undo Delete"
'UndoArray array is created when a record is deleted
CurrentRecord = UndoArray(1).RecNum
Range(Cells(CurrentRecord + RowOffset, ColumnOffset + 1),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Insert
Shift:=xlDown
For i = 1 To FieldCount
Range(UndoArray(i).Address).Formula UndoArray(i).Contents
Next i
RecordCount = RecordCount + 1

UndoButton.Visible = False
ScrollBarClicked = False
ScrollBar1.Max = RecordCount
ScrollBar1.Value = CurrentRecord
Range(Cells(CurrentRecord + RowOffset, 1 + ColumnOffset),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Select
UpdateForm
'If 1st row is being restored, copy formats from 2nd row
If UndoArray(1).RecNum = 1 Then CopyFormatsAndFormulas (1)

Case Text(16) ' "Undo Insert"
'The InsertedRow variable is set when a record is inserted
CurrentRow = ActiveCell.Row
Range(Cells(InsertedRow, ColumnOffset + 1),
Cells(InsertedRow, ColumnOffset + FieldCount)).Delete Shift:=xlUp
RecordCount = RecordCount - 1
UndoButton.Visible = False
ScrollBarClicked = False
ScrollBar1.Max = RecordCount

'Delete inserted record
CurrentRecord = InsertedRec
Range(Cells(InsertedRow, ColumnOffset + 1),
Cells(InsertedRow, ColumnOffset + FieldCount)).Select
ScrollBar1.Value = CurrentRecord
UpdateForm

Case Text(17) ' "Undo New"
'The InsertedRow variable is set when a record a new record
is added
Range(Cells(InsertedRow, ColumnOffset + 1),
Cells(InsertedRow, ColumnOffset + FieldCount)).Delete
RecordCount = RecordCount - 1
UndoButton.Visible = False
ScrollBarClicked = False
ScrollBar1.Max = RecordCount
CurrentRecord = OldRec
If CurrentRecord > RecordCount Then ' active record is the
new record
CurrentRecord = RecordCount
Range(Cells(CurrentRecord + RowOffset, 1 +
ColumnOffset), Cells(CurrentRecord + RowOffset, ColumnOffset +
FieldCount)).Select
End If
ScrollBar1.Value = CurrentRecord
UpdateForm

Case Text(18) ' "Undo Entry"
'Restores last data written to database
CurrentRecord = UndoArray(1).RecNum
ScrollBarClicked = False
ScrollBar1.Value = CurrentRecord
For i = 1 To UBound(UndoArray)
Range(UndoArray(i).Address).Formula UndoArray(i).Contents
Next i
Range(Cells(CurrentRecord + RowOffset, 1 + ColumnOffset),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Select
UpdateForm
UndoButton.Visible = False
End Select
ScrollBarClicked = True
If Err <> 0 Then
'A catch-all error message
MsgBox Text(21), vbInformation, APPNAME
End If
End Sub


Private Sub MultiPage1_Change()
'This sub is executed when the user clicks a tab on the MultiPage
control

Dim ctl As Control
Dim FieldNum As Long

'Save the user's search criteria in the Criteria array (which uses
a custom data type)
CriteriaCount = 0
FieldNum = 0
For Each ctl In Frame2.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
FieldNum = FieldNum + 1
If ctl.Text <> "" Then
CriteriaCount = CriteriaCount + 1
ReDim Preserve Criteria(1 To CriteriaCount)
Criteria(CriteriaCount).FieldNumber = FieldNum
Criteria(CriteriaCount).Value = ctl.Text
End If
End If
Next ctl

'Are there any criteria entered in Frame2?
If CriteriaCount = 0 Then CriteriaEntered = False Else
CriteriaEntered = True

'Change the captions for the Find and Next buttons, if necessary
If CriteriaEntered Then
FindPreviousButton.Caption = Text(19)
FindNextButton.Caption = Text(20)
MultiPage1.page2.Caption = "<<" & Text(3) & ">>"
Else
FindPreviousButton.Caption = Text(7)
FindNextButton.Caption = Text(8)
MultiPage1.page2.Caption = Text(3)
End If

'Set the focus to the first field
On Error Resume Next
If MultiPage1.Value = 0 Then
With Frame1.Controls(1)
.SelStart = 0
.SelLength = Len(Frame1.Controls(1).Text)
.SetFocus
End With
Else
With Frame2.Controls(1)
.SelStart = 0
.SelLength = Len(Frame1.Controls(1).Text)
.SetFocus
End With
End If
End Sub

Private Sub FindNextButton_DblClick(ByVal Cancel As
MSForms.ReturnBoolean)
'This sub is included to avoid the delay if the user clicks the
button quickly
Call FindNextButton_Click
End Sub

Private Sub FindNextButton_Click()
'Executed when the "Find Next" or "Next" button is clicked

If FindNextButton.Caption = Text(20) Then '"Find Next"
'Criteria are in effect
Call FindARecord("Down")
Else
'Criteria are not in effect
If ScrollBar1.Value <> ScrollBar1.Max Then
ScrollBar1.Value = ScrollBar1.Value + 1
Else
Beep
End If
On Error Resume Next
End If
End Sub
Private Sub FindPreviousButton_DblClick(ByVal Cancel As
MSForms.ReturnBoolean)
'This sub is included to avoid the delay if the user clicks the
button quickly
Call FindPreviousButton_Click
End Sub

Private Sub FindPreviousButton_Click()
'Executed when the "Find Prev" or "Previous" button is clicked

If FindPreviousButton.Caption = Text(19) Then '"Find Prev"
'Criteria are in effect
Call FindARecord("Up")
Else
'Criteria are not in effect
If ScrollBar1.Value <> 1 Then
ScrollBar1.Value = ScrollBar1.Value - 1
Else
Beep
End If
End If
End Sub

Private Sub FindARecord(Direction)
'Executed by the FindNextButton_Click() and
FindPreviousButton_Click() subs
'The Direction argument determines how to search (up or down)
'Using an argument eliminates the need to have two subroutines

Dim Roffset As Long 'Row offset for searching
Dim StopPoint As Long ' Where to stop searching
Dim CriteriaCount As Long 'Number of criteria entered
Dim FieldNum As Long
Dim ctl As Control
Dim OldSelection As Range
Dim OldRecord As Long
Dim AllMatch As Boolean
Dim i As Long, Row As Long
Dim RecordFound As Boolean

If Direction = "Down" Then
Roffset = 1
StopPoint = RecordCount + RowOffset + 1
Else
Roffset = -1
StopPoint = RowOffset
End If

'(Criteria are stored in Criteria array in MultiPage1_Change)

'Save the current position
Set OldSelection = Selection
OldRecord = CurrentRecord
Application.ScreenUpdating = False

UpdateDatabase

On Error Resume Next
For Row = ActiveCell.Row + Roffset To StopPoint Step Roffset
Cells(Row, ColumnOffset + 1).Activate

'Search for a matching record
RecordFound = False
'AllMatch is True if all criteria match in a record
AllMatch = True
For i = 1 To UBound(Criteria)
If Left(Criteria(i).Value, 1) = ">" Or _
Left(Criteria(i).Value, 1) = "<" Or _
Left(Criteria(i).Value, 2) = "<>" Or _
Left(Criteria(i).Value, 2) = ">=" Or _
Left(Criteria(i).Value, 2) = "<=" Or _
Left(Criteria(i).Value, 2) = "<>" Then
'Handle "greater than" or "less than" cases
Dim x, Y
x = """" & ActiveCell.Offset(0, Criteria(i).FieldNumber
- 1).Value & """"
Y = Criteria(i).Value
If Not Evaluate(ActiveCell.Offset(0,
Criteria(i).FieldNumber - 1).Value & Criteria(i).Value) Then
AllMatch = False 'It didn't match
Exit For
End If
Else
'Use the Like operator for approximate matches
If Not UCase(ActiveCell.Offset(0,
Criteria(i).FieldNumber - 1).Value) Like UCase(Criteria(i).Value) Then
AllMatch = False 'It didn't match
Exit For
End If
End If
Next i

'Did all of the criteria match?
If AllMatch Then
CurrentRecord = ActiveCell.Row - RowOffset
UpdateForm
Application.ScreenUpdating = True
ScrollBar1.Value = CurrentRecord
Exit Sub
End If
Next Row 'Didn't match, so try the next (or previous) row

'Reached the end (or beginning) and no matching records were found
MsgBox Text(22), vbInformation, APPNAME
CurrentRecord = OldRecord
OldSelection.Select
Application.ScreenUpdating = True
Exit Sub
End Sub

Private Sub DeleteButton_Click()
'Deletes the current record
Dim i As Long
ReDim UndoArray(1 To FieldCount)

'Check for last record
If RecordCount = 1 Then
MsgBox Text(23), vbInformation, APPNAME '"You can't delete the
only record."
UndoButton.Visible = False
Exit Sub
End If

'Save this info for undoing
For i = 1 To FieldCount
UndoArray(i).RecNum = CurrentRecord
UndoArray(i).Address = Cells(CurrentRecord + RowOffset, i +
ColumnOffset).Address
UndoArray(i).Contents = Cells(CurrentRecord + RowOffset, i +
ColumnOffset).PrefixCharacter & Cells(CurrentRecord + RowOffset, i +
ColumnOffset).Formula
Next i

'Display the Undo button
UndoButton.Visible = True
UndoButton.Caption = Text(15) '"Undo Delete"

'Delete it, shifting cells up
Range(Cells(CurrentRecord + RowOffset, ColumnOffset + 1),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Delete
Shift:=xlUp

'Was it the last record?
If CurrentRecord = RecordCount Then CurrentRecord = CurrentRecord -
1
Range(Cells(CurrentRecord + RowOffset, 1 + ColumnOffset),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Select

'Decrement the record count
RecordCount = RecordCount - 1

' Adjust ScrollBar1
ScrollBarClicked = False
ScrollBar1.Max = RecordCount
ScrollBar1.Value = CurrentRecord
ScrollBarClicked = True
UpdateForm
End Sub

Private Sub InsertButton_Click()
'Inserts a new record at the current position

Dim Col As Long
Dim ctl As Control

UpdateDatabase
For Each ctl In Frame1.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl = ""
Next ctl

'Error will occur if last row is not empty
On Error Resume Next

'Insert, shifting cells down
Range(Cells(CurrentRecord + RowOffset, ColumnOffset + 1),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Insert
Shift:=xlDown

If Err <> 0 Then
'"Cannot insert a new record. Likely cause: The last row of the
worksheet is not empty."
MsgBox Text(24), vbCritical, APPNAME
Exit Sub
End If

'Save this info for undoing
InsertedRow = ActiveCell.Row
InsertedRec = CurrentRecord

UndoButton.Visible = True
UndoButton.Caption = Text(16) '"Undo Insert"
RecordCount = RecordCount + 1
ScrollBar1.Max = RecordCount
Call CopyFormatsAndFormulas(1)
UpdateForm
With Frame1.Controls(1)
.SelStart = 0
.SelLength = Len(Frame1.Controls(1).Text)
.SetFocus
End With
End Sub

Private Sub NewButton_Click()
'Adds a new record to the end of the database

Dim FormulaCopied As Boolean
Dim RecordIsEmpty As Boolean
Dim Col As Long
Dim ctl As Control

'Ensure that data won't be overwritten
On Error Resume Next
RecordIsEmpty = True
For Col = 1 To FieldCount ' see if the range is empty
If Not IsEmpty(DatabaseRange.Cells(RecordCount + 2, Col)) Then
RecordIsEmpty = False
Next Col

If Not RecordIsEmpty Or Err <> 0 Then 'not empty, warn user
'"Cannot add a new record to the database because the next row
is not empty."
MsgBox Text(25), vbCritical, APPNAME
Exit Sub
End If

UpdateDatabase
For Each ctl In Frame1.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl = ""
Next ctl

RecordCount = RecordCount + 1
CurrentRecord = RecordCount
ScrollBar1.Max = RecordCount
ScrollBar1.Value = CurrentRecord

' Save this info for undoing
InsertedRow = ActiveCell.Row
InsertedRec = CurrentRecord
UndoButton.Visible = True
UndoButton.Caption = Text(17) '"Undo New"

Call CopyFormatsAndFormulas(-1)
UpdateForm
With Frame1.Controls(1)
.SelStart = 0
.SelLength = Len(Frame1.Controls(1).Text)
.SetFocus
End With

End Sub

Sub CopyFormatsAndFormulas(Direction)
'Copies formatting and formulas from a row to the current record
'Called by InsertButton and NewButton
'if Direction = -1, copy from previous row
'if Direction = 1, copy from next row

Dim Col As Long
Dim FormulaCopied As Boolean

'Copy formats
Range(ActiveCell.Offset(Direction, 0), ActiveCell.Offset(Direction,
FieldCount - 1)).Copy
ActiveCell.Select
Selection.PasteSpecial Paste:=xlPasteFormats

'Copy formulas
FormulaCopied = False
For Col = 0 To FieldCount - 1
If ActiveCell.Offset(Direction, Col).HasFormula Then
ActiveCell.Offset(0, Col).FormulaR1C1 ActiveCell.Offset(Direction, Col).FormulaR1C1
FormulaCopied = True
End If
Next Col
Application.CutCopyMode = False 'eliminates the "marquee"

'If no formulas were copied, put a dummy value in the record
'(a blank row will split up the database)
If Not FormulaCopied Then ActiveCell = "[New]"
End Sub

Private Sub CloseButton_Click()
'Unloads the form
'UpdateDatabase
Unload Me
End Sub

Private Sub ScrollBar1_Change()
'Executed whenever the horizontal scroll bar changes
Dim OldScroll As Long

'If the scroll bar was called by another sub, exit now
'ScrollBarClicked is a Public variable that's set by other subs
(such as DeleteButton_Click)
If Not ScrollBarClicked Then Exit Sub

UpdateDatabase
CurrentRecord = ScrollBar1.Value

'Select the current record
'This causes the worksheet to scroll so the currentrecord is always
visible
Range(Cells(CurrentRecord + RowOffset, 1 + ColumnOffset),
Cells(CurrentRecord + RowOffset, ColumnOffset + FieldCount)).Select

UpdateForm

'Set the focus to the first field
'For an unknown reason, the focus must first be set to the
ScrollBar1
ScrollBar1.SetFocus
On Error Resume Next
OldScroll = Frame1.ScrollTop ' Don't change user's scroll setting
With Frame1.Controls(1)
.SelStart = 0
.SelLength = Len(.Text)
.SetFocus
End With
Frame1.ScrollTop = OldScroll
End Sub


Sub UpdateForm()
'This sub updates the fields in the form
Dim ctl As Control
Dim Col As Long
Dim CurrentCell As Range
Col = 0

On Error Resume Next
For Each ctl In Frame1.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
Col = Col + 1
Set CurrentCell = Cells(CurrentRecord + RowOffset, Col +
ColumnOffset)
ctl = CurrentCell
If CurrentCell.PrefixCharacter = "'" Then ctl = "'" & ctl

'Check for True/False cells (they would appear as 0 or -1)
If Application.WorksheetFunction.IsLogical(CurrentCell)
Then
ctl = CurrentCell.Text
End If

'Is the cell displaying an error value?
If Err <> 0 Then
ctl = CurrentCell.Text 'Display this if the cell has an
error value
Err = 0
End If

'Formula?
If Cells(CurrentRecord + RowOffset, Col +
ColumnOffset).HasFormula Then
ctl.Enabled = False
ctl.BackColor = RGB(240, 240, 240)
Else
ctl.Enabled = True
ctl.BackColor = RGB(255, 255, 255)
End If
End If
Next ctl
LabelRecNum = Text(9) & " " & CurrentRecord & " " & Text(10) & " "
& RecordCount
On Error GoTo 0
End Sub

Sub UpdateDatabase()
'Updates the database with new data from the form
Dim ctl As Control
Dim Col As Long
Dim TestCell As Range
Dim NumberWritten As Long
Col = 0
NumberWritten = 0
For Each ctl In Frame1.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
Col = Col + 1
Set TestCell = Cells(CurrentRecord + RowOffset, Col +
ColumnOffset)
If Not TestCell.HasFormula Then ' Don't check formula cells
'Use Clean so cells with non-printing characters will
be compared correctly
If TestCell.PrefixCharacter &
Application.WorksheetFunction.Clean(TestCell) <>
Application.WorksheetFunction.Clean(ctl.Text) Then
'Save original data for undo
NumberWritten = NumberWritten + 1
ReDim Preserve UndoArray(1 To NumberWritten)
With UndoArray(NumberWritten)
.Address = TestCell.Address
.Contents = TestCell.PrefixCharacter &
TestCell.Text
.RecNum = CurrentRecord
End With
'write the new data
TestCell = ctl.Text
End If
End If
End If
Next ctl

If NumberWritten <> 0 Then
UndoButton.Caption = Text(18) '"Undo Entry"
UndoButton.Visible = True
End If
End Sub

Private Sub TipsButton_Click()
' Displays a msgbox from the Criteria page
Dim Msg As String
Msg = Text(26)
Msg = Msg & " " & Text(27) & vbCrLf & vbCrLf
Msg = Msg & Text(28) & vbCrLf & vbCrLf
Msg = Msg & " *" & vbTab & Text(29) & vbCrLf
Msg = Msg & " ?" & vbTab & Text(30) & vbCrLf
Msg = Msg & " #" & vbTab & Text(31) & vbCrLf
Msg = Msg & " >" & vbTab & Text(32) & vbCrLf
Msg = Msg & " <" & vbTab & Text(33) & vbCrLf
Msg = Msg & " >=" & vbTab & Text(34) & vbCrLf
Msg = Msg & " <=" & vbTab & Text(35) & vbCrLf
Msg = Msg & " <>" & vbTab & Text(36) & vbCrLf
MsgBox Msg, vbInformation, APPNAME
End Sub

Private Sub ClearCriteriaButton_Click()
'Clears all of the criteria boxes
Dim ctl As Control
For Each ctl In Frame2.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Text = ""
End If
Next ctl
MultiPage1.page2.Caption = Text(3)
End Sub

Private Sub HelpButton_Click()
'Displays the "about box"
FormAbout.Show
End Sub

Private Sub TranslateText(LanguageColumn)
'Reads the text items for the Form
Dim r As Long
For r = 1 To 36
Text(r) = ThisWorkbook.Sheets("Sheet1").Cells(r,
LanguageColumn)
Next r
If LanguageColumn <> 1 Then
Me.Caption = Text(1)
MultiPage1.Pages(0).Caption = Text(2)
MultiPage1.Pages(1).Caption = Text(3)
NewButton.Caption = Text(4)
InsertButton.Caption = Text(5)
DeleteButton.Caption = Text(6)
FindPreviousButton.Caption = Text(7)
FindNextButton.Caption = Text(8)
UndoButton.Caption = Text(11)
CloseButton.Caption = Text(12)
ClearCriteriaButton.Caption = Text(13)
TipsButton.Caption = Text(14)
End If
End Sub

Private Function UserHeight()
'Returns the height value for the Form
Dim Ht As Long
UserHeight = Me.Height
On Error Resume Next
Ht = Evaluate(ActiveWorkbook.Names("DF_HEIGHT").Value)
If Err.Number = 0 Then
If Ht > Me.Height Then UserHeight = Ht
End If
End Function

Private Function UserWidth()
'Returns the width value for the Form
Dim Wid As Long
UserWidth = Me.Width
On Error Resume Next
Wid = Evaluate(ActiveWorkbook.Names("DF_WIDTH").Value)
If Err.Number = 0 Then
If Wid > Me.Width Then UserWidth = Wid
End If
End Function

Function NameHasData(n) As Boolean
'Returns True if a defined name (n) contains data
'This is used to determine if the field should display as a
ComboBox
Dim x As Range
NameHasData = False
On Error Resume Next
Set x = Range(Evaluate(ActiveWorkbook.Names(n).RefersTo).Address)
If Err.Number = 0 Then
If Application.CountA(x) <> 0 Then NameHasData = True
End If
End Function
Function UNIQUEITEMS(ArrayIn) As Variant
Dim NoDupes As New Collection
Dim OutArray() As Variant
Dim Cell As Range, i As Long
Set ArrayIn = Intersect(ArrayIn, ArrayIn.Parent.UsedRange)
On Error Resume Next ''avoid error when adding duplicated item to
collection
For Each Cell In ArrayIn
If Not IsEmpty(Cell) And Not IsError(Cell) Then NoDupes.Add
Cell.Value, CStr(Cell.Value)
Next Cell
If NoDupes.Count = 0 Then
UNIQUEITEMS = Nothing
Else
ReDim OutArray(1 To NoDupes.Count)
For i = 1 To NoDupes.Count
OutArray(i) = NoDupes(i)
Next i
UNIQUEITEMS = OutArray
End If
End Function