I have this code but cannot get it to work?
Me.axlenumbox.RemoveItem axlenumbox.ListIndex
Can anyone assist with the placement.
My code is:
'---------------------------------------------------------------------------------------
' Module : UserForm1
' DateTime : 02/11/2005 13:49
' Author : royUK
' Website : www.excel-it.com
' Purpose : load a combobox from a closed workbook
'---------------------------------------------------------------------------------------
Option Explicit
Private Sub CommandButton1_Click()
Call UserForm_Activate
End Sub
Private Sub todaysdate_Click()
datebox.Value = Format(DateTime.Now, "DD MMM YYYY hh:mm:ss")
End Sub
Private Sub UserForm_Activate()
Dim SourceWB As Workbook
Dim rng As Range, Item As Range
Dim i As Integer
Application.ScreenUpdating = False
With Me.axlenumbox
.Clear ' remove existing entries from the combobox
' open the source workbook as ReadOnly
Set SourceWB = Workbooks.Open("J:\WHEELSET FLOW SYSTEM\LIVE SYSTEM\database_np_201403190805.xlsx", _
False, True)
'set the data range
With SourceWB.Worksheets("database")
Set rng = .Range(.Range("A5"), .Range("A" & .Rows.Count).End(xlUp))
End With
' get the values you want
For Each Item In rng
If Item.Offset(0, 3).Value <> "FAIL" Then
.AddItem Item.Value ' populate the listbox
End If
Next Item
.ListIndex = -1 ' no items selected, set to 0 to select the first item
End With
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
Application.ScreenUpdating = True
End Sub
Private Sub clearbut_Click()
' Clear the form
For Each ctl In Me.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False
End If
Next ctl
End Sub
Private Sub SUBMITBUT_Click()
Dim ws As Worksheet
Dim sFileName As String
Dim sFolderName As String
Dim LastRow As Long
Dim wbDest As Workbook
Dim pad As Long
Dim msg As String
Dim Title As String
If Not IsDate(Me.datebox.Value) Then
MsgBox "The Date box must contain a date.", vbExclamation, "Date Entry"
Me.datebox.SetFocus
Exit Sub
End If
If Me.axlenumbox.Value = "" Then
MsgBox "Please enter an Axle Number.", vbExclamation, "Axle Number?"
Me.axlenumbox.SetFocus
Exit Sub
End If
'If Me.wsettypecom.Value = "" Then
'MsgBox "Please select a Wheelset Type.", vbExclamation, "Wheelset Type?"
'Me.wsettypecom.SetFocus
'Exit Sub
'End If
If Me.bookedincom.Value = "" Then
MsgBox "Please select an operator to book in.", vbExclamation, "Booked in by?"
Me.bookedincom.SetFocus
Exit Sub
End If
If Me.statuscom.Value = "" Then
MsgBox "Please select a Status.", vbExclamation, "Pass or Fail?"
Me.statuscom.SetFocus
Exit Sub
End If
sFileName = "database_np_201403190805.xlsx"
sFolderName = "J:\WHEELSET FLOW SYSTEM\LIVE SYSTEM\"
Application.ScreenUpdating = False
If Not Dir(sFolderName & sFileName, vbDirectory) = vbNullString Then
Set wbDest = Workbooks.Open(sFolderName & sFileName, ReadOnly:=False)
Else
pad = Len(sFolderName & sFileName) / 2
msg = MsgBox(sFolderName & sFileName & Chr(10) & Chr(10) & _
Space(pad) & "File Not Found", vbInformation, Title)
GoTo progend
End If
Set ws = wbDest.Sheets("Database")
Dim Foundcell As Range
With ws
Set Foundcell = .Columns(1).Find(Me.axlenumbox.Text, LookIn:=xlValues, lookat:=xlWhole)
If Not Foundcell Is Nothing Then
'update data from userform to worksheet ranges
.Cells(Foundcell.Row, 6).Value = Me.axlenumbox.Text
.Cells(Foundcell.Row, 7).Value = Me.wsettypecom.Text
.Cells(Foundcell.Row, 8).Value = Me.bookedincom.Text
.Cells(Foundcell.Row, 9).Value = Me.statuscom.Text
.Cells(Foundcell.Row, 10).Value = Me.datebox.Text
'
' etc etc
'
Else
MsgBox Me.axlenumbox.Text & Chr(10) & "Record Not Found", 48, "Not Found"
End If
End With
Me.axlenumbox.RemoveItem axlenumbox.ListIndex
wbDest.Close True
progend:
Application.ScreenUpdating = False
Unload Me
BACKPRESSSTAGE2.Show
Application.ScreenUpdating = True
End Sub
Bookmarks