Pezzzz
Pezzzz

Reputation: 748

error 9 when referencing a cell

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

Answers (1)

Joshua Honig
Joshua Honig

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:

TryGetItem

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

Related Questions