Reputation: 748
I am using VBA in excel to create a testreport database. when I reference a cell looking for a document number I get an error script out of range (Error 9)
.
The code I am using is:
LookUpRowCounter = HeaderRow + 1
Do Until Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = ""
If Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = DocumentNumber Then
Exit Do
End If
LookUpRowCounter = LookUpRowCounter + 1
Loop
The error occurs on the If statementment for the first Record, where the counter =5. There are ten records in the datasheet "List" from row 5 to 15.
Any help Appreciated
EDIT
The Document Number has the format 0000AA000, containing numbers and capital letters.
Public Sub Archive()
'On Error GoTo Err
Dim DocumentNumber As String
Dim ProjectNumber As Single
Dim DBName As String
Dim DBLocation As String
Dim LookUpRowCounter As Single
Application.ScreenUpdating = False
DBName = "Attribute DataSheet.xls"
DBLocation = "J:\home\PEJ2WO\Database For Martin\"
DocumentNumber = ThisWorkbook.Sheets("Detail and Summary").Range("infDocumentNumber").Text
Workbooks.Open Filename:=DBLocation & DBName
If Not DocumentNumber = "" Then
'Document number present
LookUpRowCounter = HeaderRow + 1
Do Until Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = DocumentNumber
If Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = "" Then Exit Do
LookUpRowCounter = LookUpRowCounter + 1
Loop
Else
'create new document number
DocumentNumber = GetDocumentNumbers(DocumentNumber)
ThisWorkbook.Sheets("Detail and Summary").Unprotect (Password)
ThisWorkbook.Sheets("Detail and Summary").Range("infDocumentNumber").Value = DocumentNumber
'ThisWorkbook.Sheets("Detail And Summary").Range("infProjectNumber").Value = ProjectNumber
ThisWorkbook.Sheets("Detail And Summary").Protect (Password)
LookUpRowCounter = HeaderRow + 1
Do Until Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = ""
If Workbooks(DBName).Worksheets("List").Cells(LookUpRowCounter, 1).Text = DocumentNumber Then
Exit Do
End If
LookUpRowCounter = LookUpRowCounter + 1
Loop
End If
After this point there is just the code to write the values into the summary sheet, which is long winded and shouldn't be related.
Upvotes: 1
Views: 127
Reputation: 13215
Error 9 indicates you tried to get a member of a collection by an index that does not exist. In numerous places in your code you are attempting to get Workbook, Worksheet, and Range objects by hard-coded names. At least one of these does not exist even though you think it does, so you are getting the error.
Try using the following function to safely attempt to get a reference, and gracefully handle it when the member does not exist:
Function TryGetItem(ByVal Collection As Object, ByVal Index, ByRef Value) As Boolean
On Error GoTo ErrSub
If IsObject(Collection(Index)) Then
Set Value = Collection(Index)
Else
Value = Collection(Index)
End If
TryGetItem = True
Exit Function
ErrSub:
If Err.Number = 9 Then
Err.Clear
TryGetItem = False
Else
' Propogate error
Err.Raise Err.Number, , Err.Description
End If
End Function
Now here's a how you can update your existing method to use this:
Public Sub Archive()
Dim DocumentNumber As String
Dim ProjectNumber As Single
Dim DBName As String
Dim DBLocation As String
Dim LookUpRowCounter As Single
' New variables:
Dim wsDetail As Worksheet
Dim rngDocNumber As Range
Dim wbDatasheet As Workbook
Dim wsList As Worksheet
Application.ScreenUpdating = False
DBName = "Attribute DataSheet.xls"
DBLocation = "J:\home\PEJ2WO\Database For Martin\"
If Not TryGetItem(ThisWorkbook.Sheets, "Detail and Summary", wsDetail) Then
MsgBox "Worksheet 'Detail and Summary' does not exist"
End If
If Not TryGetItem(wsDetail.Names, "infDocumentNumber", rngDocNumber) Then
MsgBox "Named range 'infDocumentNumber' does not exist"
End If
DocumentNumber = rngDocNumber.Text
Set wbDatasheet = Workbooks.Open(DBLocation & DBName)
If DocumentNumber <> "" Then
If Not TryGetItem(wbDatasheet.Worksheets, "List", wsList) Then
MsgBox "Worksheet 'List' does not exist"
End If
'Document number present
LookUpRowCounter = HeaderRow + 1
Do Until wsList.Cells(LookUpRowCounter, 1).Text = DocumentNumber
If wsList.Cells(LookUpRowCounter, 1).Text = "" Then Exit Do
LookUpRowCounter = LookUpRowCounter + 1
Loop
Else
'create new document number
DocumentNumber = GetDocumentNumbers(DocumentNumber)
wsDetail.Unprotect Password
rngDocNumber.Value = DocumentNumber
wsDetail.Protect Password
LookUpRowCounter = HeaderRow + 1
Do Until wsList.Cells(LookUpRowCounter, 1).Text = ""
If wsList.Cells(LookUpRowCounter, 1).Text = DocumentNumber Then Exit Do
LookUpRowCounter = LookUpRowCounter + 1
Loop
End If
Application.ScreenUpdating = True
End Sub
Upvotes: 3