kubek
10-21-2008, 01:04 PM
Hello, i tried to look for the answeron the forumand weba page of VBA express, but unfortunately i haven't found the solution concerning my problem. I have found a great example of listbox user form:
'UserForm1 Code
Option Explicit
Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Sheet1")
With UserForm1
'If textboxes not null then fill data of textboxes to worksheet.
If (.TextBox1.Value <> vbNullString And .TextBox2.Value <> vbNullString And _
.TextBox3.Value <> vbNullString) Then
Cells(strLastRow + 1, 1).Value = UserForm1.TextBox1.Value
Cells(strLastRow + 1, 2).Value = UserForm1.TextBox2.Value
Cells(strLastRow + 1, 3).Value = UserForm1.TextBox3.Value
strLastRow = strLastRow + 1
'Update listbox with added values
UserForm1.ListBox1.RowSource = "Sheet1!A2:C" & strLastRow
'Empty textboxes
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
Else
MsgBox "Please Enter Data"
End If
End With
End Sub
Private Sub cmdDel_Click()
With UserForm1.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then
'If more then one data rows
If (.ListIndex >= 0 And xlLastRow("Sheet1") > 2) Then
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "Sheet1!A2:C" & xlLastRow("Sheet1")
'If only one data row
ElseIf (.ListIndex = 0 And xlLastRow("Sheet1") = 2) Then
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "Sheet1!A2:C2"
End If
Else
MsgBox "Please Select Data"
End If
End With
End Sub
Private Sub ListBox1_Change()
Dim SourceRange As Excel.Range
Dim Val1 As String, Val2 As String, Val3 As String
If (ListBox1.RowSource <> vbNullString) Then
'Get Range that the ListBox is bound to
Set SourceRange = Range(ListBox1.RowSource)
Else
'Get first data row
Set SourceRange = Range("Sheet1!A2:C2")
Exit Sub
End If
Val1 = ListBox1.Value
'Get the value of the second column
Val2 = SourceRange.Offset(ListBox1.ListIndex, 1).Resize(1, 1).Value
'Get the value of the third column
Val3 = SourceRange.Offset(ListBox1.ListIndex, 2).Resize(1, 1).Value
'Concatenate the three values together and display them in Label1
Label1.Caption = "Selected Data: " & vbNewLine & Val1 & " " & Val2 & " " & Val3
'Clean Up
Set SourceRange = Nothing
End Sub
Private Sub UserForm_Initialize()
'Clean data range
DeleteBlankRows
DeleteBlankColumns
'Set properties of listbox1
With Me.ListBox1
.BoundColumn = 1
.ColumnCount = 3
.ColumnHeads = True
.TextColumn = True
.RowSource = "Sheet1!A2:C" & xlLastRow("Sheet1")
.ListStyle = fmListStyleOption
.ListIndex = 0
End With
End Sub
Function xlLastRow(Optional WorksheetName As String) As Long
' find the last populated row in a worksheet
With Worksheets(WorksheetName)
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
If xlLastRow > 21 Then xlLastRow = 21
End With
End Function
I was looking on this forum and web pages how to change the range of the cells that shows listbox's window - for ex to. A20:C20-A30-C30? But as i am biginner in VBA i didnt find any clear solution. Thanks for helping me solve my problem.
'UserForm1 Code
Option Explicit
Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Sheet1")
With UserForm1
'If textboxes not null then fill data of textboxes to worksheet.
If (.TextBox1.Value <> vbNullString And .TextBox2.Value <> vbNullString And _
.TextBox3.Value <> vbNullString) Then
Cells(strLastRow + 1, 1).Value = UserForm1.TextBox1.Value
Cells(strLastRow + 1, 2).Value = UserForm1.TextBox2.Value
Cells(strLastRow + 1, 3).Value = UserForm1.TextBox3.Value
strLastRow = strLastRow + 1
'Update listbox with added values
UserForm1.ListBox1.RowSource = "Sheet1!A2:C" & strLastRow
'Empty textboxes
.TextBox1.Value = vbNullString
.TextBox2.Value = vbNullString
.TextBox3.Value = vbNullString
Else
MsgBox "Please Enter Data"
End If
End With
End Sub
Private Sub cmdDel_Click()
With UserForm1.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then
'If more then one data rows
If (.ListIndex >= 0 And xlLastRow("Sheet1") > 2) Then
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "Sheet1!A2:C" & xlLastRow("Sheet1")
'If only one data row
ElseIf (.ListIndex = 0 And xlLastRow("Sheet1") = 2) Then
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "Sheet1!A2:C2"
End If
Else
MsgBox "Please Select Data"
End If
End With
End Sub
Private Sub ListBox1_Change()
Dim SourceRange As Excel.Range
Dim Val1 As String, Val2 As String, Val3 As String
If (ListBox1.RowSource <> vbNullString) Then
'Get Range that the ListBox is bound to
Set SourceRange = Range(ListBox1.RowSource)
Else
'Get first data row
Set SourceRange = Range("Sheet1!A2:C2")
Exit Sub
End If
Val1 = ListBox1.Value
'Get the value of the second column
Val2 = SourceRange.Offset(ListBox1.ListIndex, 1).Resize(1, 1).Value
'Get the value of the third column
Val3 = SourceRange.Offset(ListBox1.ListIndex, 2).Resize(1, 1).Value
'Concatenate the three values together and display them in Label1
Label1.Caption = "Selected Data: " & vbNewLine & Val1 & " " & Val2 & " " & Val3
'Clean Up
Set SourceRange = Nothing
End Sub
Private Sub UserForm_Initialize()
'Clean data range
DeleteBlankRows
DeleteBlankColumns
'Set properties of listbox1
With Me.ListBox1
.BoundColumn = 1
.ColumnCount = 3
.ColumnHeads = True
.TextColumn = True
.RowSource = "Sheet1!A2:C" & xlLastRow("Sheet1")
.ListStyle = fmListStyleOption
.ListIndex = 0
End With
End Sub
Function xlLastRow(Optional WorksheetName As String) As Long
' find the last populated row in a worksheet
With Worksheets(WorksheetName)
xlLastRow = .Cells.Find("*", .Cells(1), xlFormulas, _
xlWhole, xlByRows, xlPrevious).Row
If xlLastRow > 21 Then xlLastRow = 21
End With
End Function
I was looking on this forum and web pages how to change the range of the cells that shows listbox's window - for ex to. A20:C20-A30-C30? But as i am biginner in VBA i didnt find any clear solution. Thanks for helping me solve my problem.