Userform delete row

D

DanAnderton

New Member
Joined
Sep 22, 2017
Messages
16
Second question of the day.

I have a delete button as part of a userform, it originally worked just fine, I've since added a column to the worksheet, adjusted all the VB code to account for it but the thing that I can't seem to get working again is the delete button.

The delete button code:
Code: 
Private Sub Delete_Click()

   Dim sil As Long
   If ListBox1.ListIndex = -1 Then
   MsgBox "Choose an entry", vbExclamation
   Exit Sub
   End If
   If ListBox1.ListIndex >= 0 Then
    cevap = MsgBox("Confirm you wish to delete this rower?", vbYesNo)
If cevap = vbYes Then
   Sheets("FullRowerDetails").Range("D:D").Find(What:=ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate
sil = ActiveCell.Row
   Sheets("FullRowerDetails").Rows(sil).Delete
                     
        End If
        End If
       
ListBox1.List = Sheets("FullRowerDetails").Range("D8:Dl00" & Cells(Rows.Count, 1).End(xlUp).Row).Value


Application.ScreenUpdating = False
Unload Me
UpdateRowers.Show
Application.ScreenUpdating = True


End Sub

The full code for the form is below:

Code: 
Private Sub AddCancel_Click()Unload Me
End Sub




Private Sub AddSubmit_Click()
Dim Degistirilecek_Satir As Long
Dim sor As String
If AddSurname = "" Or AddFirstName = "" Then
Call MsgBox("click the contact so it can be updated", vbInformation, "Edit Contact")
Exit Sub
End If


sor = MsgBox("Are your sure?", vbYesNo)
If sor = vbNo Then Exit Sub


 Degistirilecek_Satir = ListBox1.ListIndex + 8
 
    Sheets("FullRowerDetails").Range("B" & Degistirilecek_Satir).Value = WSRADate.Text
    Sheets("FullRowerDetails").Range("C" & Degistirilecek_Satir).Value = MYCDate.Text
                        
    Sheets("FullRowerDetails").Range("D" & Degistirilecek_Satir).Value = AddSurname.Text
    Sheets("FullRowerDetails").Range("E" & Degistirilecek_Satir).Value = AddFirstName.Text
    Sheets("FullRowerDetails").Range("F" & Degistirilecek_Satir).Value = AddPhone.Text
    Sheets("FullRowerDetails").Range("G" & Degistirilecek_Satir).Value = AddMobile.Text
    Sheets("FullRowerDetails").Range("H" & Degistirilecek_Satir).Value = AddEmail.Text
    Sheets("FullRowerDetails").Range("I" & Degistirilecek_Satir).Value = AddAddress.Text
    Sheets("FullRowerDetails").Range("J" & Degistirilecek_Satir).Value = AddSex.Value
    Sheets("FullRowerDetails").Range("K" & Degistirilecek_Satir).Value = AddDOB.Text
    Sheets("FullRowerDetails").Range("M" & Degistirilecek_Satir).Value = AddNOK.Text
    Sheets("FullRowerDetails").Range("N" & Degistirilecek_Satir).Value = AddNOKPhone.Text
   
    
    Sheets("FullRowerDetails").Range("O" & Degistirilecek_Satir).Value = AddFirstAid.Value
    Sheets("FullRowerDetails").Range("P" & Degistirilecek_Satir).Value = AddCoach.Value
    Sheets("FullRowerDetails").Range("Q" & Degistirilecek_Satir).Value = AddRadio.Value
    Sheets("FullRowerDetails").Range("R" & Degistirilecek_Satir).Value = AddDaySkipper.Value
    Sheets("FullRowerDetails").Range("S" & Degistirilecek_Satir).Value = AddCRB.Value
    Sheets("FullRowerDetails").Range("T" & Degistirilecek_Satir).Value = AddIntroTraining.Value
    Sheets("FullRowerDetails").Range("U" & Degistirilecek_Satir).Value = AddPowerBoat.Value
    Sheets("FullRowerDetails").Range("V" & Degistirilecek_Satir).Value = AddLifejacketTesting.Value
                




Call MsgBox("The rower has been updated", vbInformation, "Update Rower")


End Sub


Private Sub Delete_Click()


   Dim sil As Long
   If ListBox1.ListIndex = -1 Then
   MsgBox "Choose an entry", vbExclamation
   Exit Sub
   End If
   If ListBox1.ListIndex >= 0 Then
    cevap = MsgBox("Entry will be deleted. ... Are you sure ?", vbYesNo)
If cevap = vbYes Then
   Sheets("FullRowerDetails").Range("D:D").Find(What:=ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate
sil = ActiveCell.Row
   Sheets("FullRowerDetails").Rows(sil).Delete
                     
        End If
        End If
       
ListBox1.List = Sheets("FullRowerDetails").Range("D8:Dl00" & Cells(Rows.Count, 1).End(xlUp).Row).Value


Application.ScreenUpdating = False
Unload Me
UpdateRowers.Show
Application.ScreenUpdating = True


End Sub


Private Sub ListBox1_AfterUpdate()


    Dim Rw As Long
    
    Rw = ListBox1.ListIndex + 8
    
    Me.WSRADate.Value = Range("B" & Rw).Value
    Me.MYCDate.Value = Range("C" & Rw).Value
    Me.AddSurname.Value = Range("D" & Rw).Value
    Me.AddFirstName.Value = Range("E" & Rw).Value
    Me.AddPhone.Value = Range("F" & Rw).Value
    
    Me.AddMobile.Value = Range("G" & Rw).Value
    Me.AddEmail.Value = Range("H" & Rw).Value
    Me.AddAddress.Value = Range("I" & Rw).Value
    Me.AddSex.Value = Range("J" & Rw).Value
    Me.AddDOB.Value = Range("K" & Rw).Value
    Me.AddNOK.Value = Range("M" & Rw).Value
    Me.AddNOKPhone.Value = Range("N" & Rw).Value
    


    If Range("O" & Rw).Value = "True" Then Me.AddFirstAid.Value = True Else Me.AddFirstAid.Value = False
    If Range("P" & Rw).Value = "True" Then Me.AddCoach = True Else Me.AddCoach = False
    If Range("Q" & Rw).Value = "True" Then Me.AddRadio = True Else Me.AddRadio = False
    If Range("R" & Rw).Value = "True" Then Me.AddDaySkipper = True Else Me.AddDaySkipper = False
    If Range("S" & Rw).Value = "True" Then Me.AddCRB = True Else Me.AddCRB = False
    If Range("T" & Rw).Value = "True" Then Me.AddIntroTraining = True Else Me.AddIntroTraining = False
    If Range("U" & Rw).Value = "True" Then Me.AddPowerBoat = True Else Me.AddPowerBoat = False
    If Range("V" & Rw).Value = "True" Then Me.AddLifejacketTesting = True Else Me.AddLifejacketTesting = False
    
End Sub






Private Sub UserForm_Initialize()
ListBox1.ColumnCount = 2                                                 'COLUMN NUMBER OF LISTBOX
ListBox1.List = ThisWorkbook.Worksheets("FullRowerDetails").Range("D8:l" & Cells(Rows.Count, 3).End(xlUp).Row).Value
AddSex.List = Array("Male", "Female")
End Sub

Any help would be much appreciated.
 

Excel Facts

Links? Where??
If Excel says you have links but you can't find them, go to Formulas, Name Manager. Look for old links to dead workbooks & delete.
Sort by date Sort by votes
How about
Code: 
Private Sub AddClear_Click()

   Dim sil As Long
   If ListBox1.ListIndex = -1 Then
    MsgBox "Choose an entry", vbExclamation
    Exit Sub
   End If
   
   Rows(ListBox1.ListIndex + 8).Interior.Color = vbRed
   If ListBox1.ListIndex >= 0 Then
        cevap = MsgBox("Confirm you wish to delete this rower?", vbYesNo)
        If cevap = vbYes Then Rows(ListBox1.ListIndex + 8).[COLOR=#ff0000]Interior.Color = vbRed[/COLOR]
    End If
    
    ListBox1.List = Sheets("FullRowerDetails").Range("D8:Dl00" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    
    Application.ScreenUpdating = False
    Unload Me
    UpdateRowers.Show
    Application.ScreenUpdating = True


End Sub
This will initially just highlight the row red. If it's getting the correct row simply replace the part in red with .delete
 
Upvote 0
Oops.
I used one of the existing buttons, as it was easier than adding another, but forgot to change the sub name.
Replace the last code with
Code: 
Private Sub Delete_Click()

   Dim sil As Long
   If ListBox1.ListIndex = -1 Then
    MsgBox "Choose an entry", vbExclamation
    Exit Sub
   End If
   
   Rows(ListBox1.ListIndex + 8).Interior.Color = vbRed
   If ListBox1.ListIndex >= 0 Then
        cevap = MsgBox("Confirm you wish to delete this rower?", vbYesNo)
        If cevap = vbYes Then Rows(ListBox1.ListIndex + 8).[COLOR=#ff0000]Interior.Color = vbRed[/COLOR]
    End If
    
    ListBox1.List = Sheets("FullRowerDetails").Range("D8:Dl00" & Cells(Rows.Count, 1).End(xlUp).Row).Value
    
    
    Application.ScreenUpdating = False
    Unload Me
    UpdateRowers.Show
    Application.ScreenUpdating = True


End Sub
 
Upvote 0
That worked a treat, thank you.

Could you also help me something else? I'm trying to find a way to secure the actual worksheet and only allow any data to be amended using one of the userforms. Is that possible?
 
Upvote 0
Have a look for
Worksheet.protect Userinterfaceonly:=true

It will need to go in a workbook open event.

If you get no joy then post back & I'll have a look at it on Sunday
 
Upvote 0
Thank you,

I've added this that seems to work:
Code: 
Private Sub Workbook_Open()Dim wSheetName As Worksheet
For Each wSheetName In Worksheets
wSheetName.Protect Password:="Secret", UserInterFaceOnly:=True
Next wSheetName
End Sub

However, now when I try to use a userform to add a new row, it throws up an error saying table features are not available because the table is protected and highlights this line:

Code: 
    Set oNewRow = Selection.ListObject.ListRows.Add(AlwaysInsert:=True)
 
Upvote 0
I've never used tables, so I'm afraid I can't help on that.
It's probably best if you start a new thread & post the full code where you get that error.
 
Upvote 0
I found a solution, I've basically set it to unprotect the sheet when the forms are opened, and then protect the workbook again when the forms are closed. Seems to be working nicely.

Thank you for all your help. Much appreciated.
 
Upvote 0
Glad you got it sorted & thanks for the feedback
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Question Question
Run time erorr 94 when selecting value in Listbox
Replies
4
Views
105
ipbr21054
I
C
  • Question Question
Using pattern searches with a variable to find the correct values
2
Replies
10
Views
266
chazrab
C
K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
239
krunal123
K
I
  • Solved
Listbox on userform to show results in reverse order
2
Replies
16
Views
355
Fuji
F
W
  • Question Question
Posting Data with new form text boxes
Replies
0
Views
600
woodland81
W

Forum statistics

Threads
1,224,827
Messages
6,181,194
Members
453,021
Latest member
pingpong7117

Share this page

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