Userform Run-time error 1004

[kirana2014]

Dear mr / mrs,

I get run-time error 1004 when I try to delete data with cmdDelete see below the VBA

Rowsource listbox1 = information

please help me to resolve this issue
thank you in advance for your support

Kirana

Private Sub ListBox1_Click()
Dim say As Long, A As Byte, r As Long
Dinfo1 = ListBox1.List(ListBox1.ListIndex, 0)

For A = 1 To 6
Controls("Info" & A) = ListBox1.List(ListBox1.ListIndex, A - 1)
Next

Sheets("Data").Range("A:A").Find(ListBox1.Text).Activate
say = ActiveCell.Row
Sheets("Data").Range("A" & say & ":I" & say).Select
TextBox1 = ListBox1.ListIndex + 1
End Sub


Private Sub cmdDelete_Click()
Dim findvalue As Range
    Dim cDelete As VbMsgBoxResult
    Dim cNum As Integer
    'check for values
    If Info1.Value = "" Or Info2.Value = "" Then
        MsgBox "There is not data to delete"
        Exit Sub
    End If
    'give the user a chance to change their mind
    cDelete = MsgBox("Are you sure that you want to delete Select Data", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then
        'delete the row
        Set findvalue = Sheet1.Range("B:B").Find(What:=Info2, LookIn:=xlValues)
        findvalue.EntireRow.Delete
    End If
    'clear the controls
    cNum = 6
    For X = 1 To cNum
        Me.Controls("Info" & X).Value = ""
    Next
    'refresh the listbox
    Unload Me
    frmaddress.Show
End Sub

[gmr4evr1]

It has to do with this line

Sheets("Data").Range("A:A").Find(ListBox1.Text).Activate

in the "ListBox1_Click" macro. If I comment out this line, it works fine.
The error states that an application or object hasn't been defined

More info: I stepped through the code and noticed that when the delete code runs, after it does this line....

Set findvalue = Sheets("Data").Range("A:A").Find(What:=Info2, LookIn:=xlValues)
        findvalue.EntireRow.Delete

it runs back through the ListBox1_Click code. At this point the range you want to activate has already been activated so it errors??

[mjr veverka]

As gmr4evr1 above, and and additionally:
1. After deleting a row, 'ListBox1_Click' procedure runs 2x/works twice and fills the text boxes
2. Why, since after returning, to the 'cmdDelete_Click' procedure, text boxes are clearing ?
3. You haven't 'UserForm_Initialize' procedure
According to me, you should add 'UserForm_Initialize' and improve the triggering of procedures (to prevent multiple runs).
You could add e.g.:

'New procedure
Private Sub UserForm_Initialize()
    With frmaddress
        .Caption = "DATABASE"
        With .ListBox1
            .RowSource = Sheets("Data").Range("information").Address(0, 0)
            .ListIndex = -1
        End With
    End With
End Sub

and modify 'cmdDelete_Click', e.g.:

Private Sub cmdDelete_Click()
Dim findvalue As Range
Dim cDelete As VbMsgBoxResult
Dim cNum As Integer

    'check for values
    If Info1.Value = "" Or Info2.Value = "" Then
        MsgBox "There is not data to delete"
        Exit Sub
    End If
    
    'give the user a chance to change their mind
    cDelete = MsgBox("Are you sure that you want to delete Select Data", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then
        'delete the row
        Set findvalue = Sheet1.Range("B:B").Find(What:=Info2, LookIn:=xlValues)
        
        If Not findvalue Is Nothing Then                            'new line
            findvalue.EntireRow.Delete
            Set findvalue = Nothing                                 'new line
        Else                                                        'new line
            MsgBox "There is nothing to remove", vbOKOnly, "Info"   'new line
            Exit Sub                                                'new line
        End If                                                      'new line
    End If
    
    'clear the controls
    cNum = 6
    For X = 1 To cNum
        Me.Controls("Info" & X).Value = ""
    Next
    
    'refresh the listbox
    'Unload Me
    'frmaddress.Show
    
    frmaddress.ListBox1.RowSource = Sheets("Data").Range("information").Address(0, 0) 'new line
End Sub

[mehmetcik]

gmr4evr1 is right.

In this type of scenario

I Declare a public ChangeFlag as Boolean

I then set ChangeFlag as True before I perform a function that could create an error

I then set this back to False when I know that the risk of error has passed.

This code works:-

'**************************************
Public Changeflag As Boolean
'**************************************

Private Sub cmdAdd_Click()

Dim X As Integer
Dim nextrow As Range

On Error GoTo cmdAdd_Click_Error

Set nextrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
For X = 1 To 4
If Me.Controls("Info" & X).Value = "" Then
MsgBox "You must add Name ,Address ,State and Zipe"
Exit Sub
End If
Next

If WorksheetFunction.CountIf(Sheet1.Range("A:A"), Me.Info1.Value) > 0 Then
MsgBox "This Name already exists"
Exit Sub
End If

For X = 1 To 6
nextrow = Me.Controls("Info" & X).Value
Set nextrow = nextrow.Offset(0, 1)
Next
'clear
For X = 1 To 6
Me.Controls("Info" & X).Value = ""
Next

On Error GoTo 0
Exit Sub

cmdAdd_Click_Error:

MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAdd_Click of Form frmCustomer"

End Sub

Private Sub cmdClear_Click()
Unload Me
frmaddress.Show
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdDelete_Click()
Dim findvalue As Range
    Dim cDelete As VbMsgBoxResult
    Dim cNum As Integer
    'check for values
    If Info1.Value = "" Or Info2.Value = "" Then
        MsgBox "There is not data to delete"
        Exit Sub
    End If
    'give the user a chance to change their mind
    cDelete = MsgBox("Are you sure that you want to delete Select Data", vbYesNo + vbDefaultButton2, "Are you sure????")
    If cDelete = vbYes Then
        'delete the row

'**************************************
Changeflag = True
        Set findvalue = Sheet1.Range("B:B").Find(What:=Info2, LookIn:=xlValues)


        findvalue.EntireRow.Delete
    End If
    'clear the controls
    cNum = 6
    For X = 1 To cNum
        Me.Controls("Info" & X).Value = ""
    Next
    'refresh the listbox
    Unload Me
    frmaddress.Show

'**************************************
Changeflag = False

End Sub

Private Sub ListBox1_Click()

'**************************************
If Changeflag = True Then Exit Sub

Dim say As Long, A As Byte, r As Long
Dinfo1 = ListBox1.List(ListBox1.ListIndex, 0)

For A = 1 To 6
Controls("Info" & A) = ListBox1.List(ListBox1.ListIndex, A - 1)
Next

Sheets("Data").Range("A:A").Find(ListBox1.Text).Activate
say = ActiveCell.Row
Sheets("Data").Range("A" & say & ":I" & say).Select
TextBox1 = ListBox1.ListIndex + 1
End Sub


Private Sub TextBox1_Change()
TextBox1 = ListBox1.ListIndex + 1
End Sub

[kirana2014]

Dear all,

Thank you for you help

Kirana