ListBox Click to textbox & delete row

pure vito

Board Regular
Joined
Oct 7, 2021
Messages
180
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I have 2 issues to work on,

1st

I need to make a change to this sub I'm just not sure how to do it, the code worked fine before but I have made changes that have effected how it works,

Below is the code that I believe needs amending but for clarity I will also copy all the code for the userform,

Because I have added a search function to the listbox this has effected how the text boxes are populated, normally when clicking the listbox it would populate all textboxes with the data from my worksheet "People"
but now the listbox is filtered by the search so when selecting a row it's misaligned with the data I understand this may not make much sense, but I have added a copy of the workbook incase

VBA Code:
Private Sub ListBox1_Click()
  Dim col         As Long, SelectedRow As Long
 
  If updating = True Then Exit Sub
 
  SelectedRow = Me.ListBox1.ListIndex + 2
 

  'Loads textboxes with selected range values
  For col = 1 To 34
    Me.Controls("TextBox" & col).Value = sh.Cells(SelectedRow, col).Text
  Next col
End Sub


2nd

As I am writing this I've discovered a pretty major flaw in my document (I'm sure there are more) the userform allows you to delete data from the "People" tab but then removing this effects the whole document,

the end result would be in deleting a row from the listbox all rows across the workbook with the same ID in column "A" should also be deleted,

Is anyone able to add this to the current code please, I can add all the sheet names to the code across the workbook I'm just not sure how to write the code,

Here is the code I am using to delete the row selected however I think the only solution is to now add an additional column "A" to every sheet effected and add an ID to every row,

VBA Code:
Private Sub deleterow2_click()
If Me.TextBox1.Value = "" Then
MsgBox "sletect the record to delete"
Exit Sub
End If

Set sh = ThisWorkbook.Worksheets("People")
Dim Selected_Row As Long
Selected_Row = Application.WorksheetFunction.Match(CLng(Me.TextBox1.Value), sh.Range("A:A"), 0)
'---------------
sh.Range("A" & Selected_Row).EntireRow.Delete
Call Clear_Click
MsgBox "Record deleted"
End Sub

I have added a copy of my workbook the userform in question is "Nameinput"

I'd appreciate any help and thanks in advance

Test1989.xlsm

Below all the code for this userform,

VBA Code:
'Option Explicit
'Option Base 1

Dim Lastrow As Long
Dim sh As Worksheet
Dim updating As Boolean
Dim criterion



Private Sub UserForm_Activate()
Dim c As Integer
'Dim iRow As Long
Set sh = ThisWorkbook.Worksheets("People")
'iRow = sh.Range("A" & Rows.Count).End(xlUp).Row
For c = 1 To 34
Me.ComboBox1.AddItem sh.Cells(1, c).Value
Next

With Me.ListBox1
    '.RowSource = "People!A2:AG" & iRow
    .ColumnHeads = True
    .ColumnCount = 34
    .ColumnWidths = "50,120,100,60,80,100,60,100,120,50,80,80,80,80,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50,50"
  
 End With

End Sub


Private Sub ComboBox1_Change()
Dim c As Integer
Set sh = ThisWorkbook.Worksheets("People")
Dim column_headers
column_headers = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", "AA", "AB", "AC", "AD", "AE", "AF", "AG", "AH")

For c = 1 To 34
If sh.Cells(1, c).Value = Me.ComboBox1.Value Then
criterion = column_headers(c - 1)
End If
Next
sh.Cells(1, "K").Value = criterion

Me.ListBox1.Clear
Me.ListBox1.Value = ""
Me.TextBox35.SetFocus

End Sub

Private Sub TextBox35_Change()
On Error Resume Next
Set sh = ThisWorkbook.Worksheets("People")
If Me.TextBox35.Text = "" Then
Me.ListBox1.Clear
Exit Sub
End If

Me.ListBox1.Clear
Dim r, last_row As Integer
Set sh = ThisWorkbook.Worksheets("People")
last_row = sh.Range("A10000").End(xlUp).Row
For r = 2 To last_row
    a = Len(Me.TextBox35.Text)
   If UCase(Left(sh.Cells(r, criterion).Value, a)) = UCase(Me.TextBox35.Text) Then
   With Me.ListBox1
 
   .AddItem sh.Cells(r, "A").Value
   .List(.ListCount - 1, 1) = sh.Cells(r, "B").Value
   .List(.ListCount - 1, 2) = sh.Cells(r, "C").Value
   .List(.ListCount - 1, 3) = sh.Cells(r, "D").Value
   .List(.ListCount - 1, 4) = sh.Cells(r, "E").Value
   .List(.ListCount - 1, 5) = sh.Cells(r, "F").Value
   .List(.ListCount - 1, 6) = sh.Cells(r, "G").Value
   .List(.ListCount - 1, 7) = sh.Cells(r, "H").Value
   .List(.ListCount - 1, 8) = sh.Cells(r, "I").Value
   .List(.ListCount - 1, 9) = sh.Cells(r, "J").Value
   .List(.ListCount - 1, 10) = sh.Cells(r, "K").Value
   .List(.ListCount - 1, 11) = sh.Cells(r, "L").Value
   .List(.ListCount - 1, 12) = sh.Cells(r, "M").Value
   .List(.ListCount - 1, 13) = sh.Cells(r, "N").Value
   .List(.ListCount - 1, 14) = sh.Cells(r, "O").Value
   .List(.ListCount - 1, 15) = sh.Cells(r, "P").Value
   .List(.ListCount - 1, 16) = sh.Cells(r, "Q").Value
   .List(.ListCount - 1, 17) = sh.Cells(r, "R").Value
   .List(.ListCount - 1, 18) = sh.Cells(r, "S").Value
   .List(.ListCount - 1, 19) = sh.Cells(r, "T").Value
   .List(.ListCount - 1, 20) = sh.Cells(r, "U").Value
   .List(.ListCount - 1, 21) = sh.Cells(r, "V").Value
   .List(.ListCount - 1, 22) = sh.Cells(r, "W").Value
   .List(.ListCount - 1, 23) = sh.Cells(r, "X").Value
   .List(.ListCount - 1, 24) = sh.Cells(r, "Y").Value
   .List(.ListCount - 1, 25) = sh.Cells(r, "Z").Value
   .List(.ListCount - 1, 26) = sh.Cells(r, "AA").Value
   .List(.ListCount - 1, 27) = sh.Cells(r, "AB").Value
   .List(.ListCount - 1, 28) = sh.Cells(r, "AC").Value
   .List(.ListCount - 1, 29) = sh.Cells(r, "AD").Value
   .List(.ListCount - 1, 30) = sh.Cells(r, "AE").Value
   .List(.ListCount - 1, 31) = sh.Cells(r, "AF").Value
   .List(.ListCount - 1, 32) = sh.Cells(r, "AG").Value
   .List(.ListCount - 1, 33) = sh.Cells(r, "AH").Value
 
End With
End If
Next r



End Sub

Private Sub Update_Click()
'UPDATE SHEET
  Dim iRow As Long, col As Long
 
  updating = True
 
  iRow = Me.ListBox1.ListIndex + 2
 
  'Loop through each Textbox
  For col = 1 To 34
    sh.Cells(iRow, col).Value = Me.Controls("TextBox" & col).Value
  Next col
  Call Clear_Click
  MsgBox "Record Updated"
  updating = False
End Sub

Private Sub Addnew_Click()
'ADD NEW RECORD
  Dim lr As Long, col As Long
 
  If TextBox1.Value = "" Then
    MsgBox "Enter name", vbCritical
    TextBox1.SetFocus
    Exit Sub
  End If
  
  lr = sh.Range("A" & Rows.Count).End(3).Row + 1
  For col = 1 To 34
    sh.Cells(lr, col).Value = Me.Controls("TextBox" & col).Value
  Next col
 
  MsgBox "Record added"
End Sub

Private Sub ListBox1_Click()
  Dim col         As Long, SelectedRow As Long
 
  If updating = True Then Exit Sub
 
  SelectedRow = Me.ListBox1.ListIndex + 2
 

  'Loads textboxes with selected range values
  For col = 1 To 34
    Me.Controls("TextBox" & col).Value = sh.Cells(SelectedRow, col).Text
  Next col
End Sub

Private Sub Clear_Click()
  Dim ctrl        As Control        ' CREATE A CONTROL OBJECT.
  ' LOOP THROUGH EACH CONTROL, CHECK IF THE CONTROL IS A TEXTBOX.
  For Each ctrl In Me.Controls
      If TypeName(ctrl) = "TextBox" Then
          ctrl.Value = ""        'CLEAR THE VALUE.
      End If
  Next ctrl
  Dim X           As Control
  For Each X In Me.Controls
      If TypeOf X Is MSForms.CheckBox Then X.Value = False
  Next
End Sub
Private Sub deleterow2_click()
If Me.TextBox1.Value = "" Then
MsgBox "sletect the record to delete"
Exit Sub
End If

Set sh = ThisWorkbook.Worksheets("People")
Dim Selected_Row As Long
Selected_Row = Application.WorksheetFunction.Match(CLng(Me.TextBox1.Value), sh.Range("A:A"), 0)
'---------------
sh.Range("A" & Selected_Row).EntireRow.Delete
Call Clear_Click
MsgBox "Record deleted"
End Sub

     






Private Sub Nameinput_Initialize()
  z6d6e7f99b5309ffbbf47a5f7f9b43ddc
  bd69a4bbb6cd9a014b3cc15e8e1b12695 = DataSheet.Range("NQ5")
  If bd69a4bbb6cd9a014b3cc15e8e1b12695 <= 0 Or bd69a4bbb6cd9a014b3cc15e8e1b12695 = "" Or Not IsNumeric(bd69a4bbb6cd9a014b3cc15e8e1b12695) Then bd69a4bbb6cd9a014b3cc15e8e1b12695 = 100
  Me.Zoom = bd69a4bbb6cd9a014b3cc15e8e1b12695
  Me.Width = Me.Width * bd69a4bbb6cd9a014b3cc15e8e1b12695 / 100
  Me.Height = Me.Height * bd69a4bbb6cd9a014b3cc15e8e1b12695 / 100
  Private Sub Image3_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As MSForms.fmDragState, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)

End Sub

Private Sub Onglet_dezoomer_Click()
  If Me.Zoom <= 80 Then Exit Sub
  bbd8bf015281d8839caca3c0a91d70d8e -10
End Sub
Private Sub Onglet_zoomer_Click()
  bbd8bf015281d8839caca3c0a91d70d8e 10
End Sub
Private Sub bbd8bf015281d8839caca3c0a91d70d8e(ByVal b7646db0b82629ef17bf5f29e8fba7345)
  Me.Zoom = Me.Zoom + b7646db0b82629ef17bf5f29e8fba7345
  Me.Width = Me.Width * Me.Zoom / (Me.Zoom - b7646db0b82629ef17bf5f29e8fba7345)
  Me.Height = Me.Height * Me.Zoom / (Me.Zoom - b7646db0b82629ef17bf5f29e8fba7345)
  BD_DONNEES.Range("B5") = Me.Zoom
End Sub
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.

Forum statistics

Threads
1,215,069
Messages
6,122,954
Members
449,095
Latest member
nmaske

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