VBA Application Defined Error 1004

[dmqueen]

I've been slowly making progress, and learning a lot!
The size of my file (47 MB)! had something to do with it, got the go ahead to clear out the old data and was able to trim it to 33 MB. Now my computer doesn't lock up every time I us the file .
Still having run time errors. Now it's dying on a Runtime Error 1004:ApplicatioDefined or User Defined Error. Except that I have not created, expected, or handled this error in my code. Well, I suppose I did create it :O
I have to insert a new line for data entry, which will be different on each sheet, so I need to know what row number I'm on. After I find my spot to enter I store the row number gleaned from ActiveCell.Row into an Integer variable, but when I try to use it I receive the error. Ay help greatly appreciate as always! I added a comment in the code where the error is occurring. Compiles fine!
<code>
Sub fInputPart()

'col A
'add a new row
'get last PartNo.
'add 1
'generate new part no.
'CurrentWorksheet.Activate()
ActiveSheet.Range("A1").Select
'goto the top, and cycle down each line until you find the top of the entries, "="
'goto the top entry ready to insert the new entry
While ActiveCell.Value <> "="
ActiveCell.Offset(1, 0).Activate
Wend
'OK, we found the top of the entries
'Don't overwrite the =, go below
ActiveCell.Offset(1, 0).Activate
'insert the new entry row
Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
'note where we are
Dim NewRowNum As Integer
NewRowNum = ActiveCell.Row
'Application defined or object defined error 1004
'Problem with line below!!
Range("A" & NewRowNum).Select
'Goto last part number entry
'Get the last part number here!!
ActiveCell.Offset(1, 0).Activate
Dim LastPartNO As Integer
'Put the new part number here!!
ActiveCell.Value = fGenerateNextPartNumber(Application.ActiveCell.Value)
'go to next col
'col B
Range("B" & ActiveCell.Row).Select
'verify entry was made
'go to next col
'while there are columns for data entry (has column title) verify entry was made in last column,
'error msg if not,
'go to next column if made
While (NewRowNum & ActiveCell.Column <> "")
'while there are columns left for entry: there is a column header
'go to the next column for entry that is active and has a width not equal to 1
'verify entry was made in last column: holler and stop if not: continue if made
'blank allowed only for "NOTES" column!

If ActiveCell.Offset(0, -1) = Null Then
Range(ActiveCell.Column & "6").Select
If (ActiveCell.Value()) <> "NOTES" Then

Call MsgBox("Please enter/select a value in the previous column! ", vbExclamation, Application.Name)

Else
'if inactive(width=1, jump it, else goto next column and stop for entry
If ActiveCell.Offset(0, 1).ColumnWidth = 1 Then
ActiveCell.Offset(0, 2).Activate
Else: ActiveCell.Offset(0, 1).Activate
End If
End If
End If
Wend
Call MsgBox("Entry Complete, thank you! Don't forget to save when done! ", vbInformation, Application.Name)
End Sub
Public Function fGenerateNextPartNumber(LastPartIn As String) As String
Dim LastPartNO As String
LastPartNO = LastPartIn
'LastPartNo = ActiveCell.Value
Dim NewStrPartNo As String
Dim strseparator As String
Dim strPartNo As String
Dim strLastPartNo As String

strPartNo = ActiveSheet.Name()
Dim strSeperator As String
Dim strLastSeqPartNo As String
strLastPartNo = (Right(LastPartIn, 4))
'debugging
Call MsgBox("Generating Part Number!" & LastPartNO)

Dim strNewSeqPartNo As String
Dim intNewSeqNo As Integer

Dim intLastSeqNo As Integer
'handle special case separators HERE!
Dim lastseqNo As Integer

intLastSeqNo = CInt(strLastPartNo)
intNewSeqNo = intLastSeqNo + 1
'debugging
Call MsgBox("Generating Part Number! Last Part No. is" & strPartNo)
If strPartNo = "180" Or strPartNo = "300" Or strPartNo = "310" Or strPartNo = "320" Or strPartNo = "330" Or strPartNo = "970" Or strPartNo = "681" Or strPartNo = "981" Then
strseparator = "-1-"

Else: strseparator = "-0-"
End If
'put in return stmt 4 compiler
NewStrPartNo = strPartNo + strseparator + CStr(intNewSeqNo)
'return statement
fGenerateNextPartNumber = NewStrPartNo

End Function
</code>
:wink:

 

[mole999]

First thing change Dim NewRowNum As Integer to Dim NewRowNum As LONG

Sub fInputPart()

'col A
'add a new row
'get last PartNo.
'add 1
'generate new part no.
'CurrentWorksheet.Activate()
    ActiveSheet.Range("A1").Select
    'goto the top, and cycle down each line until you find the top of the entries, "="
    'goto the top entry ready to insert the new entry
    While ActiveCell.Value <> "="
        ActiveCell.Offset(1, 0).Activate
    Wend
    'OK, we found the top of the entries
    'Don't overwrite the =, go below
    ActiveCell.Offset(1, 0).Activate
    'insert the new entry row
    Selection.EntireRow.Insert , CopyOrigin:=xlFormatFromLeftOrAbove
    'note where we are
    Dim NewRowNum As Integer
    NewRowNum = ActiveCell.Row
    'Application defined or object defined error 1004
    'Problem with line below!!
    Range("A" & NewRowNum).Select
    'Goto last part number entry
    'Get the last part number here!!
    ActiveCell.Offset(1, 0).Activate
    Dim LastPartNO As Integer
    'Put the new part number here!!
    ActiveCell.Value = fGenerateNextPartNumber(Application.ActiveCell.Value)
    'go to next col
    'col B
    Range("B" & ActiveCell.Row).Select
    'verify entry was made
    'go to next col
    'while there are columns for data entry (has column title) verify entry was made in last column,
    'error msg if not,
    'go to next column if made
    While (NewRowNum & ActiveCell.Column <> "")
    'while there are columns left for entry: there is a column header
    'go to the next column for entry that is active and has a width not equal to 1
    'verify entry was made in last column: holler and stop if not: continue if made
    'blank allowed only for "NOTES" column!

        If ActiveCell.Offset(0, -1) = Null Then
            Range(ActiveCell.Column & "6").Select
            If (ActiveCell.Value()) <> "NOTES" Then

                Call MsgBox("Please enter/select a value in the previous column! ", vbExclamation, Application.Name)

            Else
    'if inactive(width=1, jump it, else goto next column and stop for entry
                If ActiveCell.Offset(0, 1).ColumnWidth = 1 Then
                    ActiveCell.Offset(0, 2).Activate
                Else: ActiveCell.Offset(0, 1).Activate
                End If
            End If
        End If
    Wend
    Call MsgBox("Entry Complete, thank you! Don't forget to save when done! ", vbInformation, Application.Name)
End Sub
Public Function fGenerateNextPartNumber(LastPartIn As String) As String
    Dim LastPartNO As String
    LastPartNO = LastPartIn
    'LastPartNo = ActiveCell.Value
    Dim NewStrPartNo As String
    Dim strseparator As String
    Dim strPartNo As String
    Dim strLastPartNo As String

    strPartNo = ActiveSheet.Name()
    Dim strSeperator As String
    Dim strLastSeqPartNo As String
    strLastPartNo = (Right(LastPartIn, 4))
    'debugging
    Call MsgBox("Generating Part Number!" & LastPartNO)

    Dim strNewSeqPartNo As String
    Dim intNewSeqNo As Integer

    Dim intLastSeqNo As Integer
    'handle special case separators HERE!
    Dim lastseqNo As Integer

    intLastSeqNo = CInt(strLastPartNo)
    intNewSeqNo = intLastSeqNo + 1
    'debugging
    Call MsgBox("Generating Part Number! Last Part No. is" & strPartNo)
    If strPartNo = "180" Or strPartNo = "300" Or strPartNo = "310" Or strPartNo = "320" Or strPartNo = "330" Or strPartNo = "970" Or strPartNo = "681" Or strPartNo = "981" Then
        strseparator = "-1-"

    Else: strseparator = "-0-"
    End If
    'put in return stmt 4 compiler
    NewStrPartNo = strPartNo + strseparator + CStr(intNewSeqNo)
    'return statement
    fGenerateNextPartNumber = NewStrPartNo

End Function

you might also try

NewRowNum = .Range("E" & Rows.Count).End(xlUp) choose the best column</pre>

 

[dmqueen]

I tried changing the type to Long, same error. I could count the rows, I could also add a counter to my While loop since I start at the top and go line by line to find my entry spot. Thanks for the try. All attempts welcome!