Run time error 1004 - Application defined or object defined error

dss28

Board Regular
Joined
Sep 3, 2020
Messages
165
Office Version
  1. 2007
Platform
  1. Windows
I have a form in which I have 15 rows for data input and each row has a series of boxes and comboboxes.

Each row has a separate command button to save the data to sheet.

The basic code is same except each line command button has reference to the respective textboxes/comboxes in that row.
VBA Code:

I had no issues with the code for almost 5-6 months but now suddenly the code is giving "Run time error 1004 - Application defined or object defined error" and stopping intermittently on any row. sometimes it goes through but then it is stuck on the first line iteself for last couple of days and can not go further.

for internet i tried to gather information about this error and I tried to use :

1. "Thisworkbook.sheets("SheetName").activate code as there are two sheets involved in the code transfer from userform to sheet.
2. .value added in the code eg. "Sheet3.Cells(final, 1) = UserForm38.ComboBox1.Value"

but no success.

please help to resolve the issue.

The code stops at line "Sheet3.Cells(final, 1) = UserForm38.ComboBox1.Value"


VBA Code:
Private Sub cmd39_Click()
Dim i As Integer
Dim final As Double
Dim j As Integer
Dim actual As Double

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

ThisWorkbook.Sheets("Data").Activate   ‘ sheet3

For i = 1 To 1000
If Sheet3.Cells(i, 1) = "" Then
final = i
Exit For
End If
Next

Application.ScreenUpdating = False

Sheet3.Cells(final, 1) = UserForm38.ComboBox1.Value     
Sheet3.Cells(final, 2) = UserForm38.TextBox1.Value     
Sheet3.Cells(final, 3) = UserForm38.TextBox69.Value     
Sheet3.Cells(final, 4) = Format(UserForm38.TextBox8, "0.00000000")     
Sheet3.Cells(final, 5) = UserForm38.ComboBox16.Value         
Sheet3.Cells(final, 6) = UserForm38.TextBox7.Value     
Sheet3.Cells(final, 7) = Format(UserForm38.TextBox6, "dd/mm/yyyy")     
Sheet3.Cells(final, 8) = UserForm38.Label17     
Sheet3.Cells(final, 9) = UserForm38.TextBox114.Value     
Sheet3.Cells(final, 10) = UserForm38.TextBox14.Value     
Sheet3.Cells(final, 11) = Format(UserForm38.TextBox115, "0.000000")     
Sheet3.Cells(final, 13) = Format(UserForm38.TextBox130, "0.000")     
Sheet3.Cells(final, 15) = Format(UserForm38.TextBox160, "0.000")     
Sheet3.Cells(final, 16) = UserForm38.TextBox177.Value     

Application.ScreenUpdating = False

For j = 1 To 1000
If sheet6.Cells(j, 1) = Sheet3.Cells(final, 1) Then

Application.ScreenUpdating = False

actual = sheet6.Cells(j, 3)
final = actual - UserForm38.TextBox8
sheet6.Cells(j, 3) = final
Exit For
End If
Next

Application.ScreenUpdating = False

MsgBox "Data of 1st row saved"


UserForm39.Hide

Application.ScreenUpdating = False

UserForm38.CommandButton3.Caption = "Data Saved"
UserForm38.CommandButton3.BackColor = &HFF00&
UserForm38.CommandButton3.Enabled = False

Application.DisplayAlerts = False
ThisWorkbook.Save
Application.DisplayAlerts = True
 

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

End Sub
 

Excel Facts

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
if 'final' has no value after the for i ... loop then the cell reference will be row = 0 which will cause the error
 
Upvote 0
thank you sir
I am sorry but I don't understand too much in vba coding. has been building up codes with the help of internet and some logic so far.

can you suggest a solution / addition in the code.
I added "On error resume next " at the start of code after the declaration, the error message did not come but the line data was not saved on the the sheet.
any other code can you please suggest.
 
Upvote 0
Using Sheets("Sheet3") instead of Sheet3
 
Upvote 0
if 'final' has no value after the for i ... loop then the cell reference will be row = 0 which will cause the error
thank you sir
I am sorry but I don't understand too much in vba coding. has been building up codes with the help of internet and some logic so far.

can you suggest a solution / addition in the code.
I added "On error resume next " at the start of code after the declaration, the error message did not come but the line data was not saved on the the sheet.
any other code can you please suggest.

In the sheet "Data" rows upto 1000 are updated with data now, and the error started showing after this only.

Is that the code "For i = 1 To 1000" has any thing to do with this?
 
Upvote 0
thank you sir
I am sorry but I don't understand too much in vba coding. has been building up codes with the help of internet and some logic so far.

can you suggest a solution / addition in the code.
I added "On error resume next " at the start of code after the declaration, the error message did not come but the line data was not saved on the the sheet.
any other code can you please suggest.

In the sheet "Data" rows upto 1000 are updated with data now, and the error started showing after this only.

Is that the code "For i = 1 To 1000" has any thing to do with this?

if 'final' has no value after the for i ... loop then the cell reference will be row = 0 which will cause the error

further to the above post, I deleted few rows data from the sheet"Data" and tried the data entry.
I could enter only those many lines of data upto row number 1000 but after that the same error appeared. proving that the code "For i = 1 To 1000" has something thing to do with this error.

can you please suggest further on this observation,
 
Upvote 0
Try replacing this
VBA Code:
ThisWorkbook.Sheets("Data").Activate   ‘ sheet3

For i = 1 To 1000
If Sheet3.Cells(i, 1) = "" Then
final = i
Exit For
End If
Next
with
VBA Code:
Final = ThisWorkbook.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
 
Upvote 0
Try replacing this
VBA Code:
ThisWorkbook.Sheets("Data").Activate   ‘ sheet3

For i = 1 To 1000
If Sheet3.Cells(i, 1) = "" Then
final = i
Exit For
End If
Next
with
VBA Code:
Final = ThisWorkbook.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1).Row
do i have to replace these 6 lines

For i = 1 To 1000
If Sheet3.Cells(i, 1) = "" Then
final = i
Exit For
End If
Next

with the one line suggested "Final = ThisWorkbook.Sheets("Data").Range("A" & Rows.Count).End(xlUp).Offset(1).Row"
or only the line "final = i"
 
Upvote 0
Delete all the code that I said to replace & just use the one line that I suggested.
 
Upvote 0
Delete all the code that I said to replace & just use the one line that I suggested.
sir, this worked well and I could go past 1000 row mark without issue. thanks a lot.

need another advice on the last part of this code

the last part of the above code -

VBA Code:
For j = 1 To 1000
If sheet6.Cells(j, 1) = Sheet3.Cells(final, 1) Then

Application.ScreenUpdating = False

actual = sheet6.Cells(j, 3)
final = actual - UserForm38.TextBox8
sheet6.Cells(j, 3) = final
Exit For
End If
Next

also contains similar 1000 value, and the sheet6 has data upto 600 rows till now. will it affect this code latter on based on the above logic?

also I have another userform38 and the code for row 1 has the same coding, will it affect the search in this case also?

will it be ok to replace 1000 by any other number such as 999999999 or what ever max figure allowed by excel for a quick fix


VBA Code:
[CODE=vba]
Private Sub ComboBox1_Click()                   'row1

Dim i As Integer
Dim final As Integer
Dim final1 As Integer
Dim final22 As Integer
Dim final222 As Integer
Dim FINAL2 As Double
Dim j As Integer
Dim FinalA  As Double
Dim FinalLOD As Double
 
For i = 2 To 1000               
If Sheet5.Cells(i, 1) = "" Then
final = i - 1
Exit For
End If
Next

For i = 2 To 1000                 
If Sheet2.Cells(i, 1) = "" Then
final1 = i - 1
Exit For
End If
Next


For i = 2 To 1000                   
If Sheet2.Cells(i, 1) = "" Then
final222 = i - 1
Exit For
End If
Next

For i = 2 To 1000                     
If Sheet2.Cells(i, 1) = "" Then
final22 = i - 1
Exit For
End If
Next

For i = 2 To 1000
If sheet6.Cells(i, 1) = "" Then         
FINAL2 = i - 1
Exit For
End If
Next

For i = 2 To 1000                   
If Sheet2.Cells(i, 1) = "" Then
 FinalA = i - 1
Exit For
End If
Next

For i = 2 To 1000                     
If Sheet2.Cells(i, 1) = "" Then
 FinalLOD = i - 1
Exit For
End If
Next

For i = 2 To final
If ComboBox1 = Sheet5.Cells(i, 1) Then               
TextBox1 = Sheet5.Cells(i, 2)                         

Exit For
End If
Next

For i = 2 To final1
If ComboBox1 = Sheet2.Cells(i, 1) Then               
TextBox13 = Sheet2.Cells(i, 10)                 
Exit For
End If
Next

For i = 2 To final22
If ComboBox1 = Sheet2.Cells(i, 1) Then               
TextBox14 = Sheet2.Cells(i, 4)                 
Exit For
End If
Next

For i = 2 To final222
If ComboBox1 = Sheet2.Cells(i, 1) Then               
TextBox69 = Sheet2.Cells(i, 7)                 
Exit For
End If
Next

For i = 2 To FinalA
If ComboBox1 = Sheet2.Cells(i, 1) Then               
TextBox130 = Sheet2.Cells(i, 11)               
Exit For
End If
Next

For i = 2 To FinalLOD
If ComboBox1 = Sheet2.Cells(i, 1) Then               
TextBox160 = Sheet2.Cells(i, 13)                 
Exit For
End If
Next

For j = 1 To FINAL2                             
If ComboBox1 = sheet6.Cells(j, 1) Then
TextBox2 = sheet6.Cells(j, 3)                       
Exit For
End If
Next


End Sub

Private Sub ComboBox1_Enter()
Dim i As Integer
Dim final As Integer
Dim item As String

ComboBox1.BackColor = &H80000005

For i = 1 To ComboBox1.ListCount

               'Remove an item from the ListBox.
               ComboBox1.RemoveItem 0

           Next i

For i = 2 To 1000
If Sheet5.Cells(i, 1) = "" Then
final = i - 1
Exit For
End If
Next

'If ComboBox1.ListCount < 1 Then

'ComboBox1.AddItem "-"
For i = 2 To final
item = Sheet5.Cells(i, 1)
ComboBox1.AddItem (item)
Next

'End If

End Sub



Private Sub TextBox8_Change()
Dim i As Integer
Dim final As Integer
Dim j As Integer
Dim validate As Boolean

Dim BAL As Double
Dim Bef As Double
Dim Now As Double

 
For i = 1 To 1000
If sheet6.Cells(i, 1) = "" Then
final = i
Exit For
End If
Next

For j = 1 To final
If ComboBox1 = sheet6.Cells(j, 1) Then
Bef = sheet6.Cells(j, 3)

validate = IsNumeric(TextBox8.Value)
If validate = False Then
MsgBox "  enter data  "                         
TextBox8.BackColor = &HFF00&
Exit Sub
End If

Now = TextBox8
If TextBox8 = "" Or TextBox8 = 0 Then
Now = 0
TextBox9 = ""
End If

BAL = Bef - Now
TextBox9 = BAL
Exit For


End If

If TextBox8.Value > TextBox2.Value Then TextBox8.BackColor = &HFF&       
 

Next
End Sub
[/CODE]
 
Upvote 0

Forum statistics

Threads
1,215,334
Messages
6,124,321
Members
449,154
Latest member
pollardxlsm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top