Just made the necessary correction to your specific need, and didn't really look at the formatting of the code. Use this for the submit button
Code:
Private Sub BtnSubmit_Click()
Dim wsS As Worksheet
Dim wsR As Worksheet
Application.ScreenUpdating = False
Dim irow As Long, lngLoop As Long
Set wsS = Worksheets("Resultant")
'find first row in database
irow = wsS.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
With wsS
For lngLoop = 0 To Me.ListStaIncNo.ListCount - 1
.Range("A" & irow + lngLoop).Value = Trim(Me.BxStaDistrict.Value)
.Range("B" & irow + lngLoop).Value = Trim(Me.BxStaTown.Value)
.Range("C" & irow + lngLoop).Value = Trim(Me.BxStaName.Value)
.Range("D" & irow + lngLoop).Value = Me.ListStaIncNo.List(lngLoop)
.Range("E" & irow + lngLoop).Value = Date
.Range("F" & irow + lngLoop).Value = Time
.Range("G" & irow + lngLoop).Value = Environ$("USERNAME")
Next lngLoop
End With
MsgBox "Data succesfully saved to database"
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
In addition, there's a fault with your listbox getting refreshed. The items has to be cleared first, before loading again with other criterias via the combobox. For that, I've added one line in this routine
Code:
Private Sub BxStaName_AfterUpdate()
Dim Cl As Range
Dim ClAddress As String
With Me
With Sheets("Source")
Set rSource = .Range(.Cells(1, 4), .Cells(.Rows.Count, 1).End(xlUp))
End With
'if no selection in OIC quit
If .BxStaName.ListIndex < 0 Then Exit Sub
Set Cl = rSource.Find(Me.BxStaName.Value, LookIn:=xlValues)
If Not Cl Is Nothing Then
ClAddress = Cl.Address
Me.ListStaIncNo.Clear
Do
.ListStaIncNo.AddItem Cl.Offset(0, 1).Value
Set Cl = rSource.FindNext(Cl)
Loop While Not Cl Is Nothing And Cl.Address <> ClAddress
End If
End With
End Sub
And here's the file.
By the way, hope you've read the guidelines about forum cross posting.
Reply With Quote
Originally Posted by Excel Fox
Bookmarks