Option Explicit
Dim Found As Integer
Private Sub ComboBox1_Change()
Dim Counter As Integer, QPItem As String
Dim sh As Worksheet
Set sh = Worksheets("Data")
For Counter = 2 To sh.Range("A65536").End(xlUp).Row
QPItem = sh.Range("C" & Counter).Value
If sh.Range("B" & Counter) = ComboBox1.Value Then ComboBox3 = QPItem
Next Counter
End Sub
Private Sub CommandButton1_Click()
ComboBox2 = ""
TextBox1 = ""
TextBox2 = ""
TextBox3 = ""
OptionButton1 = False
OptionButton2 = False
End Sub
Private Sub CommandButton2_Click() ' Cancel
Unload Me
End Sub
Private Sub CommandButton3_Click() ' OK
Application.ScreenUpdating = False
Dim QuickPick, Engine, Gearbox, Platform, XWD, Turbo, Misc, Response, Shift, MixNumber, Operator, MyYear, MyMonth, MyDay
Dim ResultOK As Boolean
Dim MeasuredDate, Comment, LastRow As Integer, Counter As Integer
Dim EngineToMeasure, GearboxToMeasure, EngineSubVariant, GearboxMainVariant
Dim sh As Worksheet
Set sh = Worksheets("Valid variants")
' Check that the Date field has been filled in with a correct date.
If TextBox1 = "" Or Not IsDate(TextBox1) Then
MsgBox "Please enter a valid date.", vbExclamation, "Date missing"
Exit Sub
End If
If (DateValue(TextBox1)) > DateValue(Now()) Then
MsgBox "Are you sure that you performed the torque audit in the future?" & Chr(13) _
& "You have entered " & ConvertMonthName(Month(DateValue(TextBox1))) & " " & Day(DateValue(TextBox1)) _
& ", " & Year(DateValue(TextBox1)) & Chr(13) & "Today's date is " & ConvertMonthName(Month(Now)) _
& " " & Day(Now) & ", " & Year(Now) & Chr(13) & Chr(13) & "Please use the calendar button.", vbExclamation _
, "Wrong date?"
Exit Sub
End If
If ComboBox1 = "" Then
MsgBox "Please fill in who performed the measurements.", vbExclamation, "Operator name missing"
Exit Sub
End If
If ComboBox3 = "" Then
MsgBox "Please fill the shift in which the joints were measured.", vbExclamation, "Shift missing"
Exit Sub
End If
If ComboBox2 = "" Then
MsgBox "Please choose a quick-pick variant.", vbExclamation, "Variant missing"
Exit Sub
End If
If TextBox2 = "" Then
MsgBox "Please fill in a mix number.", vbExclamation, "Mix number missing"
Exit Sub
End If
If Not IsNumeric(TextBox2) Then
MsgBox "The mix number has to be numeric.", vbExclamation, "Data not valid."
Exit Sub
End If
Unload Me
'=============
Operator = ComboBox1.Value
Counter = ComboBox2.ListIndex + 3
QuickPick = sh.Range("B" & Counter).Value
Engine = sh.Range("C" & Counter)
Gearbox = sh.Range("D" & Counter)
XWD = sh.Range("E" & Counter)
Turbo = sh.Range("F" & Counter)
Misc = sh.Range("G" & Counter)
EngineToMeasure = sh.Range("H" & Counter).Value
Platform = sh.Range("I" & Counter).Value
EngineSubVariant = sh.Range("J" & Counter).Value
If EngineSubVariant = "" Then EngineSubVariant = "All"
If InStr(EngineSubVariant, " ") > 0 Then EngineSubVariant = Split(EngineSubVariant, " ")(0)
GearboxToMeasure = sh.Range("K" & Counter).Value
If InStr(GearboxToMeasure, " /") > 0 Then
GearboxMainVariant = Split(GearboxToMeasure, " /")(0)
Else
GearboxMainVariant = "N/A"
End If
Shift = ComboBox3
MixNumber = TextBox2
MeasuredDate = TextBox1
MyYear = Split(MeasuredDate, "-")(0) 'Year(MeasuredDate)
MyMonth = Split(MeasuredDate, "-")(1) 'Month(MeasuredDate)
MyDay = Split(MeasuredDate, "-")(2) 'Day(MeasuredDate)
Call ResidualTorqueSheet(QuickPick, Engine, Gearbox, Platform, XWD, Turbo, Misc, EngineToMeasure, GearboxToMeasure, _
EngineSubVariant, GearboxMainVariant, Operator, MixNumber, Shift, MyYear, MyMonth, MyDay)
End Sub
Private Sub CommandButton4_Click()
Calendar1.Show
End Sub
Private Sub userform_initialize()
Dim Counter As Integer
Dim sh As Worksheet
Dim Gearbox As String, Other As String, QPItem As String
Dim User As String
Dim AddZeroMonth As String, AddZeroday As String
Dim OffLine
Set OffLine = CreateObject("Scripting.Dictionary")
User = VBA.LCase(Environ("username"))
Application.ScreenUpdating = False
Set sh = Worksheets("Data")
ComboBox3.Clear
ComboBox3.AddItem "A-ploeg"
ComboBox3.AddItem "B-ploeg"
ComboBox3.AddItem "N-ploeg"
ComboBox3.AddItem "D-ploeg"
' User - who measured?
For Counter = 2 To sh.Range("A65536").End(xlUp).Row
QPItem = sh.Range("B" & Counter).Value
If Not OffLine.exists(QPItem) Then
OffLine.Add QPItem, 1
ComboBox1.AddItem QPItem
End If
If sh.Range("A" & Counter) = User Then ComboBox1 = QPItem
QPItem = sh.Range("C" & Counter).Value
If sh.Range("A" & Counter) = User Then ComboBox3 = QPItem
Next Counter
If Month(Now) < 10 Then AddZeroMonth = "0"
If Day(Now) < 10 Then AddZeroday = "0"
TextBox1.Value = Year(Now) & "-" & AddZeroMonth & Month(Now) & "-" & AddZeroday & Day(Now)
' Quick-pick
Set sh = Worksheets("Valid variants")
For Counter = 3 To sh.Range("B1048576").End(xlUp).Row
Gearbox = sh.Range("D" & Counter)
Other = sh.Range("E" & Counter)
QPItem = sh.Range("B" & Counter) & ") " & sh.Range("C" & Counter)
If Gearbox <> "All" Then QPItem = QPItem & " - " & Gearbox
If Other <> "" Then QPItem = QPItem & " - " & Other
Other = sh.Range("F" & Counter)
If Other <> "" Then QPItem = QPItem & " - " & Other
Other = sh.Range("G" & Counter)
If Other <> "" Then QPItem = QPItem & " - " & Other
ComboBox2.AddItem QPItem
Next Counter
End Sub
