'--------------------------------------------------------------------------------------- ' Module : UserForm1
' DateTime : 02/11/2005 13:49
' Author : royUK
' Website : [url=http://www.excel-it.com]royUK's Excel Site[/url]
' Purpose : load a combobox from a closed workbook
'---------------------------------------------------------------------------------------
Option Explicit
Private Sub AXLENUMCOM_Change()
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\database_np_201403190805.xlsx", _
False, True)
'set the data range
With SourceWB.Worksheets("database")
[COLOR=#ff0000][B] Set rng = .Range(.Range("A5"), .Range("A65536" & .Rows.Count).End(xlUp))[/B][/COLOR]
End With
' get the values you want
SourceWB.Close False ' close the source workbook without saving changes
Set SourceWB = Nothing
For Each Item In rng
If Item.Offset(0, 12).Value <> "Complete" 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
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
sFileName = "database_np_201403190805.xlsx"
sFolderName = "J:\WHEELSET FLOW 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, 11).Value = Me.axlenumbox.Text
.Cells(Foundcell.Row, 12).Value = Me.wsettypecom.Text
.Cells(Foundcell.Row, 13).Value = Me.bookedincom.Text
'
' etc etc
'
Else
MsgBox Me.axlenumbox.Text & Chr(10) & "Record Not Found", 48, "Not Found"
End If
End With
wbDest.Close True
progend:
Application.ScreenUpdating = False
Unload Me
BACKPRESS.Show
Application.ScreenUpdating = True
End Sub