Listbox edit

mrmrf

New Member
Joined
Jun 3, 2019
Messages
34
Hi.


I have the below code to add data from a userform to a worksheet. Within the userform i also have a listbox which displays the data.


Now what i am trying to do is for when a row of data is selected within the listbox, the text box input fields populate matching the data, so when i press add, the data overwrites.


I have been playing with the below, but dont think i am on the right path.. Any suggestions.


Thanks.

Code:
Private Sub AddButton_Click()


Dim wks As Worksheet
Dim AddNew As Range
Set wks = Sheets("Samples")
Set AddNew = wks.Range("A65356").End(xlUp).Offset(1, 0)


AddNew.Offset(0, 0).Value = txt1.Text
AddNew.Offset(0, 1).Value = txt2.Text
AddNew.Offset(0, 2).Value = txt3.Text
AddNew.Offset(0, 3).Value = txt4.Text
AddNew.Offset(0, 4).Value = txt5.Text
AddNew.Offset(0, 9).Value = txt6.Text
AddNew.Offset(0, 10).Value = txt7.Text




lstDisplay.ColumnCount = 12
lstDisplay.RowSource = "'Samples'!A1:L65356"


End Sub


Private Sub ClearButton_Click()


Dim iControl As Control


For Each iControl In Me.Controls


If iControl.Name Like "txt*" Then iControl = VbNullStrong


Next


End Sub


Private Sub DeleteButton2_Click()
Dim ws As Worksheet
Dim I As Long


    Set ws = Worksheets("Samples")
    
    With ws


        For I = 1 To .Range("A65356").End(xlUp).Row - 1
            If lstDisplay2.Selected(I) Then
                .Rows(I + 1).Delete
            End If
         Next I


    End With


End Sub


Code:
Private Sub lstDisplay_Click()
txt1.Value = lstDisplay.Value
End Sub


Private Sub txt1_Change()
Dim rCell As Range
With lstDisplay
Set rCell = Range(.RowSource).Offset(.ListIndex).Resize(1)
rCell.Value = txt1.Value
End With
End Sub
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
What part are you having problems with?
 
Upvote 0
I'm having a number of problems with the second part.


If there is no data on the worksheet, clicking in the first text box, then trying to enter data returns an error "application-defined or object-defined error"


If there was data on the worksheet however for example, the second issue is, it doesn't overwrite the data, instead adds another duplicated row. Ideally, textbox1 uses a unique job number field which would overwrite the row of other data if this is duplicated.

Thanks!

Code:
Private Sub lstDisplay_Click()
txt1.Value = lstDisplay.Value
txt2.Value = lstDisplay.Value
txt3.Value = lstDisplay.Value
txt4.Value = lstDisplay.Value
txt5.Value = lstDisplay.Value
txt6.Value = lstDisplay.Value
txt7.Value = lstDisplay.Value
End Sub


Private Sub txtLabSampleNo_Change()
Dim rCell As Range
With lstDisplay
Set rCell = Range(.RowSource).Offset(.ListIndex).Resize(1)
rCell.Value = txt1.Value
End With
End Sub
 
Upvote 0
Ok i have been searching a lot on how to best edit data from a listbox selection.

I can now have the textboxes on the userform populate when i select in the listbox but its the edit vba im struggling with.

I have tried to use the below VBA attached to an edit button, however it keeps resulting in an error. It appears to edit but the error clears the listbox of all conents, however data is still on worksheet.

Any ideas? im heading in the right direction?

Thansk.

Code:
Private Sub CommandButton4_Click()
'declare the variables
Dim findvalue As Range
Dim cNum As Integer
Dim DataSH As Worksheet
On Error GoTo errHandler:
Application.ScreenUpdating = False
Set DataSH = Sheet2
If txtLabSampleNo.Value = "" Then
MsgBox "There is not data to edit"
Exit Sub
End If
lstDisplay.RowSource = ""
Set findvalue = DataSH.Range("A:A"). _
Find(What:=Me.txtLab.Value, LookIn:=xlValues, LookAt:=xlWhole)
findvalue = txtLab.Value
findvalue.Offset(0, 1) = txtSample.Value
findvalue.Offset(0, 2) = txtm1.Value
findvalue.Offset(0, 3) = txtm2.Value
findvalue.Offset(0, 4) = txtm3.Value
findvalue.Offset(0, 9) = txtLength.Value
findvalue.Offset(0, 10) = txtShr.Value
DataSH.Range("A1").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("Data!$N$1:$N$2"), CopyToRange:=Range("Data!$0$1:$Z$1"), _
Unique:=False
If DataSH.Range("O9").Value = "" Then
lstDisplay.RowSource = ""
Else
lstDisplay.RowSource = DataSH.Range("outdata").Address(external:=True)
End If
Sheet2.Select
On Error GoTo 0
Exit Sub
errHandler:
MsgBox "An Error has Occurred "
End Sub
 
Upvote 0
Are you trying to update the listbox with the values from the listboxes?

What errors are you getting?

How are you initially populating the listbox?


PS If you don't want to clear the listbox remove this.
Code:
lstDisplay.RowSource = ""
 
Upvote 0
Hi Norie.

What i am trying to do is edit data on a worksheet through a userform.

The data is displayed in a listbox on this userform which data can be entered using text boxes on the userform.

If i click on the listbox items, the text boxes populate. I then am trying to edit the data within the text boxes, useing the code to overwrite the data, then update what is seen in the listbox.

The error i get is "run-time error '1004': Method 'Range of object'_global' Failed

Interesting thing is, when i run the code, the listbox clears and errors but the data has been amended. If i remove the the clear row the data is not updated.

I use the below to populate the listbox

Thank you for your help

Code:
Private Sub lstDisplay_Click()

txtLabSampleNo.Text = Me.lstDisplay.List(lstDisplay.ListIndex, 0)


txtSample = Me.lstDisplay.List(lstDisplay.ListIndex, 1)
txtm1.Text = Me.lstDisplay.List(lstDisplay.ListIndex, 2)
txtm2.Text = Me.lstDisplay.List(lstDisplay.ListIndex, 3)
txtm3.Text = Me.lstDisplay.List(lstDisplay.ListIndex, 4)
txtLength.Text = Me.lstDisplay.List(lstDisplay.ListIndex, 9)
txtShr.Text = Me.lstDisplay.List(lstDisplay.ListIndex, 10)






End Sub
 
Upvote 0
With a lot! of trial and error i think i'm almost there.

Now i just need to better handle an error message.

Currently if the code can not find the unique value in the txtLabSampleNo text box i get a runtime error.

Is there a way to have an error message saying not found in the case if the user accidentally changes the unique value when updating the data as this is the value i use to find?

Thanks.




Code:
Private Sub CommandButton4_Click()

'declare the variables
Dim findvalue As Range
Dim cNum As Integer
Dim DataSH As Worksheet
Set DataSH = Sheet2


'check for values
If txtLabSampleNo.Value = "" Then
MsgBox "There is not data to edit"
Exit Sub
End If


'clear the listbox
lstDisplay.RowSource = ""


'find the row to edit
Set findvalue = DataSH.Range("A:A"). _
Find(What:=Me.txtLabSampleNo.Value, LookIn:=xlValues, LookAt:=xlWhole)


'update the values
findvalue = txtLabSampleNo.Value
findvalue.Offset(0, 1) = txtSampleDepth.Value
findvalue.Offset(0, 2) = txtm1.Value
findvalue.Offset(0, 3) = txtm2.Value
findvalue.Offset(0, 4) = txtm3.Value
findvalue.Offset(0, 9) = txtLength.Value
findvalue.Offset(0, 10) = txtShr.Value


'refresh/reload listbox
lstDisplay.RowSource = "Samples!A1:L6535"


Exit Sub


End Sub
 
Upvote 0

Forum statistics

Threads
1,223,888
Messages
6,175,215
Members
452,618
Latest member
Tam84

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