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
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,
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,
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