Solved: User Form Problems

[coliervile]

When the last row of information is deleted from the listbox via the "Delete" button the listbox gets the following error...
"Run-time error '380': Could not set the RowSorce propert. Invalid property value."

Private Sub cmdDel_Click()
With frmRequest.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then

'If more then one data rows
If (.ListIndex >= 0 And xlLastRow("Leave Request") > 2) Then
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "'Leave Request'!A2:E" & xlLastRow("Leave Request")

'If only one data row
ElseIf (.ListIndex = 0 And xlLastRow("Leave Request") = 2) Then
Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "'Leave Request'!A2:E"
End If
Else
MsgBox "Please Select Data"

End If
End With
End Sub

The columns in the listbox are Name, Requested, Type, Start, and End. Once the listbox reloads the columns are set to Column A, Column B Column C, Column D, and Column E and the the first row in the listbox is Name, Requested, Type, Start, and End. How can I keep this from happening and keep the columns set as Name, Requested, Type, Start, and End???

Issue number two; how can I have the listbox update immediately after information is added, removed or edited via the userform "frmRequest".

Issue number three; if the last row of information is deleted from the listbox and then a new row is added this new information doesn't fill the Edit Selection form, "UserForm4"???

Best regards,

Charlie

[tstav]

The "red part" misses the Row coordinate. It should be

.RowSource = "'Leave Request'!A2:E" & xlLastRow("Leave Request")

[Bob Phillips]

quicker to use



.RowSource = "'Leave Request'!A2:E2"

[coliervile]

Thanks "tstav" that takes care of the problem of Delete function. Is there a better way of keeping the headers set to "Name, Requested, Type, Start, and End"???

I also can't figure out why the listbox also doesn't load the "Edit Selection"???

Best regards,

Charlie

[coliervile]

Thanks "xld", but isn't that what I have already???

Best regards,

Charlie

[tstav]

Sorry Charlie, gotto go...
I' ll be with you again tomorrow.

tstav

[Bob Phillips]

No you are missing the 2. tstav gave you code to work out the row to insert, but the test had already determined that it was 2, so it is wasteful to run the test again. In fact the best code would be this IMO



Private Sub cmdDel_Click()
Dim mpLastRow As Long

With frmRequest.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then

'If more then one data rows
mpLastRow = xlLastRow("Leave Request")
If .ListIndex >= 0 Then

Range(.RowSource)(.ListIndex + 1, 1).EntireRow.Delete
'Update listbox
.RowSource = "'Leave Request'!A2:E" & mpLastRow
Else

MsgBox "Please Select Data"
End If
End If
End With
End Sub

[coliervile]

Sorry for doubting you :bow: . It works great. Is there a reason that you can see why the edit form dosn't load the information???

Best regards,

Charlie

[coliervile]

Found my own error: If (.ListIndex >= 0 And xlLastRow("Leave Request") > 2) Then

changed the 2 to a 1 and it works correctly.

Private Sub UserForm_Initialize()
With frmRequest.ListBox1
'Check for selected item
If (.Value <> vbNullString) Then

'If more then one data rows
If (.ListIndex >= 0 And xlLastRow("Leave Request") > 1) Then

UserForm4.TextBox1.Value = Range(.RowSource)(.ListIndex + 1, 1).Value
UserForm4.TextBox2.Value = Range(.RowSource)(.ListIndex + 1, 2).Value
UserForm4.TextBox3.Value = Range(.RowSource)(.ListIndex + 1, 3).Value
UserForm4.TextBox4.Value = Range(.RowSource)(.ListIndex + 1, 4).Value
UserForm4.TextBox5.Value = Range(.RowSource)(.ListIndex + 1, 5).Value

End If
End If
End With
'Unload Me
End Sub

Best regards,

Charlie

[coliervile]

Another problem has come up. I've taken the worksheet "Leave Request and hidden it and when a new request is submitted through the userform "frmRequest" it does everything it is suppose to except update the listbox on the userform "frmRquest". Here's the coding and the workbook....


Best regards,

Charlie


Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Leave Request")

Sheets("Leave Request").Visible = True
Sheets("Leave Request").Select

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for a name
If Trim(Me.cboName.Value) = "" Then
Me.cboName.SetFocus
MsgBox "Please enter your name"
Exit Sub
End If

'check for a type
If Trim(Me.cboType.Value) = "" Then
Me.cboType.SetFocus
MsgBox "Please enter requested leave"
Exit Sub
End If

'check for a start
If Trim(Me.txtStart.Value) = "" Then
Me.txtStart.SetFocus
MsgBox "Please enter start date"
Exit Sub
End If

'check for a end
If Trim(Me.txtEnd.Value) = "" Then
Me.txtEnd.SetFocus
MsgBox "Please enter end date"
Exit Sub
End If

'copy the data to the database
Application.EnableEvents = True
ws.Cells(iRow, 1).Value = Me.cboName.Value
ws.Cells(iRow, 3).Value = Me.cboType.Value
ws.Cells(iRow, 4).Value = Me.txtStart.Value
ws.Cells(iRow, 5).Value = Me.txtEnd.Value
Application.EnableEvents = False

'clear the data
Me.cboName.Value = ""
Me.cboType.Value = ""
Me.txtStart.Value = ""
Me.txtEnd.Value = ""
Me.cboName.SetFocus

Sheets("Leave Request").Visible = False

End Sub

[Bob Phillips]

Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet

Set ws = Worksheets("Leave Request")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for a name
If Trim(Me.cboName.Value) = "" Then
Me.cboName.SetFocus
MsgBox "Please enter your name"
Exit Sub
End If

'check for a type
If Trim(Me.cboType.Value) = "" Then
Me.cboType.SetFocus
MsgBox "Please enter requested leave"
Exit Sub
End If

'check for a start
If Trim(Me.txtStart.Value) = "" Then
Me.txtStart.SetFocus
MsgBox "Please enter start date"
Exit Sub
End If

'check for a end
If Trim(Me.txtEnd.Value) = "" Then
Me.txtEnd.SetFocus
MsgBox "Please enter end date"
Exit Sub
End If


Sheets("Leave Request").Visible = True
Sheets("Leave Request").Select

'copy the data to the database
Application.EnableEvents = False
ws.Cells(iRow, 1).Value = Me.cboName.Value
ws.Cells(iRow, 3).Value = Me.cboType.Value
ws.Cells(iRow, 4).Value = Me.txtStart.Value
ws.Cells(iRow, 5).Value = Me.txtEnd.Value
Me.ListBox1.RowSource = "'Leave Request'!A2:E" & xlLastRow("Leave Request")
Application.EnableEvents = True

'clear the data
Me.cboName.Value = ""
Me.cboType.Value = ""
Me.txtStart.Value = ""
Me.txtEnd.Value = ""
Me.cboName.SetFocus

Sheets("Leave Request").Visible = False

End Sub

[coliervile]

"xld" that does work and takes care of the problem, but it loads up so fast that the userform "frmRequest unloads so quickly on to the "Leave Request" worksheet that the date/time (formatted: dd-mmm-yyy hh:mm:ss) stamp doesn't fill in column "B"???


Best regards,

Charlie

[coliervile]

The date and time stamp in column "B" on the "Leave Request" worksheet runs on a Worksheet_Change Event:

Best regards,

Charlie

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Cell As Range
For Each Cell In Target
With Cell
If .Column = Range("A:A").Column Then
Cells(.Row, "B").Value = Format(Now, "dd mmm yyyy hh:mm:ss")
End If
End With
Next Cell

If Not Intersect(Target, Me.Range("B:B", "E:E")) Is Nothing Then

Me.Columns("A:E").Sort Key1:=Me.Range("D2"), Order1:=xlAscending, _
Key2:=Me.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End If
End Sub

[coliervile]

I'm getting an hour glass icon when I run the following after the date fills the textbox on the userform. If you click else where on the user form the hour glass disappears. Is there a way to get rid of the hour glass???

I also have the rremaining problems listed in threads 11-13. any ideas on these?

Best regards,

Charlie

[coliervile]

Here's the coding that's causing the hour glass icon:

Charlie

Private Sub txtEnd_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Load frmCalendar
frmCalendar.ocxCalendar.Value = Now()
If Not frmCalendar.UserCancelled Then
If IsDate(frmCalendar.ocxCalendar.Value) Then
txtEnd.Text = Format(frmCalendar.ocxCalendar.Value, "dd-mmm-yyyy")
End If
End If
Unload frmCalendar
txtEnd.SelStart = 1
txtEnd.SelLength = Len(txtEnd.Text)

End Sub

[coliervile]

Here's the coding that's causing the hour glass icon:

Charlie

Private Sub txtEnd_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Load frmCalendar
frmCalendar.ocxCalendar.Value = Now()
If Not frmCalendar.UserCancelled Then
If IsDate(frmCalendar.ocxCalendar.Value) Then
txtEnd.Text = Format(frmCalendar.ocxCalendar.Value, "dd-mmm-yyyy")
End If
End If
Unload frmCalendar
txtEnd.SelStart = 1
txtEnd.SelLength = Len(txtEnd.Text)

End Sub

[coliervile]

I've added this coding in red and it seems to have taken care of the problems, but I don't think it's really the correct way of coding???

Best regards,

Charlie

Private Sub cmdAdd_Click()
Dim iRow As Long
Dim ws As Worksheet
Set ws = Worksheets("Leave Request")

'find first empty row in database
iRow = ws.Cells(Rows.Count, 1) _
.End(xlUp).Offset(1, 0).Row

'check for a name
If Trim(Me.cboName.Value) = "" Then
Me.cboName.SetFocus
MsgBox "Please enter your name"
Exit Sub
End If

'check for a type
If Trim(Me.cboType.Value) = "" Then
Me.cboType.SetFocus
MsgBox "Please enter requested leave"
Exit Sub
End If

'check for a start
If Trim(Me.txtStart.Value) = "" Then
Me.txtStart.SetFocus
MsgBox "Please enter start date"
Exit Sub
End If

'check for a end
If Trim(Me.txtEnd.Value) = "" Then
Me.txtEnd.SetFocus
MsgBox "Please enter end date"
Exit Sub
End If

Sheets("Leave Request").Visible = True
Sheets("Leave Request").Select

'copy the data to the database
Application.EnableEvents = True
ws.Cells(iRow, 1).Value = Me.cboName.Value
ws.Cells(iRow, 3).Value = Me.cboType.Value
ws.Cells(iRow, 4).Value = Me.txtStart.Value
ws.Cells(iRow, 5).Value = Me.txtEnd.Value
Application.EnableEvents = False
'clear the data
Me.cboName.Value = ""
Me.cboType.Value = ""
Me.txtStart.Value = ""
Me.txtEnd.Value = ""
Me.cboName.SetFocus

Unload Me

Sheets("Leave Request").Visible = False

frmRequest.Show

End Sub

[coliervile]

I've got everything right now working the way I want it to except one item!!!!! :banghead: :help :dunno :bug: The value from the textbox "txtEnd" from the userform "frmRequest" isn't unloading on to the worksheet "Leave Request" the first three boxes are unloading correctly. If I get this issued cleared up everything is okay to go.....PLEASE HELP!!!!!

Best Regards,

Charlie

Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Leave Request")

Sheets("Leave Request").Visible = True
Sheets("Leave Request").Select

With frmRequest
'If textboxes not null then fill data of textboxes to worksheet.
If (.cboName.Value <> vbNullString And .cboType.Value <> vbNullString And _
.txtStart.Value <> vbNullString And .txtEnd.Value <> vbNullString) Then
Cells(strLastRow + 1, 1).Value = frmRequest.cboName.Value
Cells(strLastRow + 1, 3).Value = frmRequest.cboType.Value
Cells(strLastRow + 1, 4).Value = frmRequest.txtStart.Value
Cells(strLastRow + 1, 5).Value = frmRequest.txtEnd.Value
strLastRow = strLastRow + 1

'Update listbox with added values
frmRequest.ListBox1.RowSource = "'Leave Request'!A2:E2" & strLastRow

'Empty textboxes
.cboName.Value = vbNullString
.cboType.Value = vbNullString
.txtStart.Value = vbNullString
.txtEnd.Value = vbNullString

Else
MsgBox "Please Enter Data"


End If
End With
Unload Me
With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With
Sheets("Leave Request").Visible = False
End Sub

[Bob Phillips]

Nothing obvious, post the workbook.

[coliervile]

Here you go... I still get the hour glass when I put the dates in the txtStart and txtEnd boxes???

Best regards,

Charlie

[Bob Phillips]

I think it is the worksheet events getting in the way.

Also best to cast the date, and absolutely no need to close the form down and make the sheet visible



Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Leave Request")

Application.EnableEvents = False

With Sheets("Leave Request")

'If textboxes not null then fill data of textboxes to worksheet.
If (.cboName.Value <> vbNullString And .cboType.Value <> vbNullString And _
.txtStart.Value <> vbNullString And .txtEnd.Value <> vbNullString) Then

.Cells(strLastRow + 1, 1).Value = frmRequest.cboName.Value
.Cells(strLastRow + 1, 3).Value = frmRequest.cboType.Value
.Cells(strLastRow + 1, 4).Value = CDate(frmRequest.txtStart.Text)
.Cells(strLastRow + 1, 5).Value = CDate(frmRequest.txtEnd.Text)
strLastRow = strLastRow + 1

'Update listbox with added values
frmRequest.ListBox1.RowSource = "'Leave Request'!A2:E2" & strLastRow

'Empty textboxes
frmRequest.cboName.Value = vbNullString
frmRequest.cboType.Value = vbNullString
frmRequest.txtStart.Value = vbNullString
frmRequest.txtEnd.Value = vbNullString

Else

MsgBox "Please Enter Data"
End If
End With

Application.EnableEvents = True

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With

End Sub

[coliervile]

Good morning "xld" when I run the code I recieve this Run-Time error '438':
Object doesn't support this property or method The area highlighted in red is where the debug takes you.

Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Leave Request")

Application.EnableEvents = False

With Sheets("Leave Request")

'If textboxes not null then fill data of textboxes to worksheet.
If (.cboName.Value <> vbNullString And .cboType.Value <> vbNullString And _
.txtStart.Value <> vbNullString And .txtEnd.Value <> vbNullString) Then

.Cells(strLastRow + 1, 1).Value = frmRequest.cboName.Value
.Cells(strLastRow + 1, 3).Value = frmRequest.cboType.Value
.Cells(strLastRow + 1, 4).Value = CDate(frmRequest.txtStart.Text)
.Cells(strLastRow + 1, 5).Value = CDate(frmRequest.txtEnd.Text)
strLastRow = strLastRow + 1

'Update listbox with added values
frmRequest.ListBox1.RowSource = "'Leave Request'!A2:E2" & strLastRow

'Empty textboxes
frmRequest.cboName.Value = vbNullString
frmRequest.cboType.Value = vbNullString
frmRequest.txtStart.Value = vbNullString
frmRequest.txtEnd.Value = vbNullString

Else

MsgBox "Please Enter Data"
End If
End With

Application.EnableEvents = True

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With

End Sub

Best regards,

Charlie

[coliervile]

Good morning "xld" when I run the code I recieve this Run-Time error '438':
Object doesn't support this property or method The area highlighted in red is where the debug takes you.

Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Leave Request")

Application.EnableEvents = False

With Sheets("Leave Request")

'If textboxes not null then fill data of textboxes to worksheet.
If (.cboName.Value <> vbNullString And .cboType.Value <> vbNullString And _
.txtStart.Value <> vbNullString And .txtEnd.Value <> vbNullString) Then

.Cells(strLastRow + 1, 1).Value = frmRequest.cboName.Value
.Cells(strLastRow + 1, 3).Value = frmRequest.cboType.Value
.Cells(strLastRow + 1, 4).Value = CDate(frmRequest.txtStart.Text)
.Cells(strLastRow + 1, 5).Value = CDate(frmRequest.txtEnd.Text)
strLastRow = strLastRow + 1

'Update listbox with added values
frmRequest.ListBox1.RowSource = "'Leave Request'!A2:E2" & strLastRow

'Empty textboxes
frmRequest.cboName.Value = vbNullString
frmRequest.cboType.Value = vbNullString
frmRequest.txtStart.Value = vbNullString
frmRequest.txtEnd.Value = vbNullString

Else

MsgBox "Please Enter Data"
End If
End With

Application.EnableEvents = True

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With

End Sub

Best regards,

Charlie

[Bob Phillips]

Sorry my bad



Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Leave Request")

Application.EnableEvents = False

With Sheets("Leave Request")

'If textboxes not null then fill data of textboxes to worksheet.
If (frmRequest.cboName.Value <> vbNullString And frmRequest.cboType.Value <> vbNullString And _
frmRequest.txtStart.Value <> vbNullString And frmRequest.txtEnd.Value <> vbNullString) Then

.Cells(strLastRow + 1, 1).Value = frmRequest.cboName.Value
.Cells(strLastRow + 1, 3).Value = frmRequest.cboType.Value
.Cells(strLastRow + 1, 4).Value = CDate(frmRequest.txtStart.Text)
.Cells(strLastRow + 1, 5).Value = CDate(frmRequest.txtEnd.Text)
strLastRow = strLastRow + 1

'Update listbox with added values
frmRequest.ListBox1.RowSource = "'Leave Request'!A2:E2" & strLastRow

'Empty textboxes
frmRequest.cboName.Value = vbNullString
frmRequest.cboType.Value = vbNullString
frmRequest.txtStart.Value = vbNullString
frmRequest.txtEnd.Value = vbNullString

Else

MsgBox "Please Enter Data"
End If
End With

Application.EnableEvents = True

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With

End Sub


Isn't it still sleep time in Tennessee?

[coliervile]

"xld" two thing are now occuring: 1- the Worksheet_Change Event on the worksheet "Leave Request" is not entering the time/date stamp when new information is added. 2- When I enter the dates into the userform "frmRequest" I'm still getting the Hour glass and have to click else where in the form to continue. Any ideas on why these are happening???

Best regards,

Charlie

[Bob Phillips]

I closed my test workbook without saving, so I had to recretae it, and didn't re-tests.

This should work now



Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Leave Request")

Application.EnableEvents = False

With Sheets("Leave Request")

'If textboxes not null then fill data of textboxes to worksheet.
If (frmRequest.cboName.Value <> vbNullString And frmRequest.cboType.Value <> vbNullString And _
frmRequest.txtStart.Value <> vbNullString And frmRequest.txtEnd.Value <> vbNullString) Then

.Cells(strLastRow + 1, 1).Value = frmRequest.cboName.Value
.Cells(strLastRow + 1, 2).Value = Format(Now, "dd mmm yyyy hh:mm:ss")
.Cells(strLastRow + 1, 3).Value = frmRequest.cboType.Value
.Cells(strLastRow + 1, 4).Value = CDate(frmRequest.txtStart.Text)
.Cells(strLastRow + 1, 5).Value = CDate(frmRequest.txtEnd.Text)
strLastRow = strLastRow + 1

'Update listbox with added values
frmRequest.ListBox1.RowSource = "'Leave Request'!A2:E2" & strLastRow

'Empty textboxes
frmRequest.cboName.Value = vbNullString
frmRequest.cboType.Value = vbNullString
frmRequest.txtStart.Value = vbNullString
frmRequest.txtEnd.Value = vbNullString

Else

MsgBox "Please Enter Data"
End If
End With

Application.EnableEvents = True

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With

End Sub


Don't know about the other problem, I don't get that here.

[coliervile]

That seem to take care of everything. One thing that does happen is when one or more new entries are added to the listbox and before the listbox is closed there are a bunch of circle bullets on the left with no associated data (i.e. Name, Requested (date/time stamp), Type, Start and End) just the bullets and empty cells. Once the userform is turned off and the back on all of these excess bullets and cells are gone.

Best regards,

Charlie

[Bob Phillips]

You left a redundant 2 in there



Private Sub cmdAdd_Click()
Dim strLastRow As Integer
'Get last row
strLastRow = xlLastRow("Leave Request")

Application.EnableEvents = False

With Sheets("Leave Request")

'If textboxes not null then fill data of textboxes to worksheet.
If (frmRequest.cboName.Value <> vbNullString And frmRequest.cboType.Value <> vbNullString And _
frmRequest.txtStart.Value <> vbNullString And frmRequest.txtEnd.Value <> vbNullString) Then

.Cells(strLastRow + 1, 1).Value = frmRequest.cboName.Value
.Cells(strLastRow + 1, 2).Value = Format(Now, "dd mmm yyyy hh:mm:ss")
.Cells(strLastRow + 1, 3).Value = frmRequest.cboType.Value
.Cells(strLastRow + 1, 4).Value = CDate(frmRequest.txtStart.Text)
.Cells(strLastRow + 1, 5).Value = CDate(frmRequest.txtEnd.Text)
strLastRow = strLastRow + 1

'Update listbox with added values
frmRequest.ListBox1.RowSource = "'Leave Request'!A2:E" & strLastRow

'Empty textboxes
frmRequest.cboName.Value = vbNullString
frmRequest.cboType.Value = vbNullString
frmRequest.txtStart.Value = vbNullString
frmRequest.txtEnd.Value = vbNullString

Else

MsgBox "Please Enter Data"
End If
End With

Application.EnableEvents = True

With Worksheets("Leave Request")
.Range("A:E").Sort Key1:=.Range("D2"), Order1:=xlAscending, _
Key2:=.Range("B2"), Order2:=xlAscending, _
Header:=xlYes
End With

End Sub

[coliervile]

Not to be redundant again, but thanks for your help. It was really frustrating me trying to get all of this to work on the Userform...I don't have any hair left...LOL. Have a good day and THANKS!!!! Now it's off to another thread, but research first.

Best regards,

Charlie