User form not update correctly

C

Cyril Beki

Board Regular
Joined
Sep 18, 2021
Messages
57
Office Version
  1. 2016
Platform
  1. Windows
I almost done with my userform and when i try to update the first row, it doesn't update correctly instead it will use the data 1st row (No8) and update it in the 11th row (No18). Refer image for references. But when i try to update the other row, it works perfectly, only the 1st row is the problem. I hope someone can help me, Thanks in advance
Passdown2 selamanya ubah 99.xlsm
 

Attachments

  • Update wrongly.PNG
    Update wrongly.PNG
    8.2 KB · Views: 13

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
Sort by date Sort by votes
Cyril Beki said:
I almost done with my userform and when i try to update the first row, it doesn't update correctly instead it will use the data 1st row (No8) and update it in the 11th row (No18). Refer image for references. But when i try to update the other row, it works perfectly, only the 1st row is the problem. I hope someone can help me, Thanks in advance
Passdown2 selamanya ubah 99.xlsm
Click to expand...
Show us your script.
 
Upvote 0
VBA Code: 
Private Sub Add_Click()

Dim text As Object
Set text = Sheet6.Range("A5000").End(xlUp)

If txtDown1.Value = "" Then
MsgBox "Fill in the Downtime", vbCritical
Exit Sub
End If

If txtUp1.Value = "" Then
MsgBox "Fill in the Uptime", vbCritical
Exit Sub
End If

Select Case MsgBox("You will saved the recent data" _
& vbCrLf & "Are you sure?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Adding Data")
Case vbNo
Exit Sub
Case vbYes
End Select

'Numbering
Me.txtNo.Value = "=Row()-1"

'Adding command
text.Offset(1, 0).Value = Me.txtNo.Value
text.Offset(1, 1).Value = Me.txtSection.Value
text.Offset(1, 2).Value = Me.txtDate.Value

'Day/Night
If Me.txtDay.Value = True Then
text.Offset(1, 3).Value = "Day"
End If
If Me.txtNight.Value = True Then
text.Offset(1, 3).Value = "Night"
End If

'Shift
If Me.txtA.Value = True Then
text.Offset(1, 4).Value = "A"
End If
If Me.txtB.Value = True Then
text.Offset(1, 4).Value = "B"
End If
If Me.txtC.Value = True Then
text.Offset(1, 4).Value = "C"
End If

'Machine
text.Offset(1, 5).Value = Me.txtMachine.Value

'Category
text.Offset(1, 6).Value = Me.txtCategory.Value

'Tube/Paddle/Side
text.Offset(1, 7).Value = Me.txtTube.Value

'Alarm Message
text.Offset(1, 8).Value = Me.txtAlarm.Value

'Problem
text.Offset(1, 9).Value = Me.txtProblem.Value

'Action Taken
text.Offset(1, 10).Value = Me.txtAction.Value

'Action By
Dim i As Long
Dim strActionBy As String

strActionBy = ""

For i = 0 To txtActionby.ListCount - 1
    If txtActionby.Selected(i) Then strActionBy = IIf(strActionBy = "", txtActionby.List(i), strActionBy & vbLf & txtActionby.List(i)) ' There is a space after comma for readability
Next i

text.Offset(1, 11).Value = strActionBy

'Machine Status
If Me.txtUp.Value = True Then
text.Offset(1, 12).Value = "Up"
End If
If Me.txtDown.Value = True Then
text.Offset(1, 12).Value = "Down"
End If

'Uptime Downtime
text.Offset(1, 13).Value = Me.txtDown1.Value
text.Offset(1, 14).Value = Me.txtUp1.Value
text.Offset(1, 15).Value = _
Abs(TimeValue(Me.txtUp1) - TimeValue(Me.txtDown1))

'Part Change
text.Offset(1, 16).Value = Me.txtPart1.Value

Sheet6.Select
Me.ListBox1.RowSource = Sheet6.Range("Passdown").Address(EXTERNAL:=True)
MsgBox ("Data is added succesfully")

'Clear form after add
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""

Sheet6.Select
Dim lastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  lastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(lastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
  
End Sub
Private Sub CommandButton1_Click()
txtDate.Value = Format(Date, "Medium Date")
End Sub

Private Sub CommandButton2_Click()
txtDate.Value = Format(Date - 1, "Medium Date")
End Sub

Private Sub Update_Click()
On Error GoTo eRWIN
Dim UbahData As Object

If txtDown1.Value = "" Then
MsgBox "Fill in the Downtime", vbCritical
Exit Sub
End If

If txtUp1.Value = "" Then
MsgBox "Fill in the Uptime", vbCritical
Exit Sub
End If

If Me.txtNo.Value = "" Then
Call MsgBox("Select The Data", vbInformation, "Data Update")
Else
Set UbahData = Sheet6.Range("A9:A10000").Find(What:=Me.txtNo.Value, LookIn:=xlValues)

'Section
UbahData.Offset(0, 1).Value = Me.txtSection.Value

'Date
UbahData.Offset(0, 2).Value = Me.txtDate.Value


'Day/Night
If Me.txtDay.Value = True Then
UbahData.Offset(0, 3).Value = "Day"
End If
If Me.txtNight.Value = True Then
UbahData.Offset(0, 3).Value = "Night"
End If

'Shift
If Me.txtA.Value = True Then
UbahData.Offset(0, 4).Value = "A"
End If
If Me.txtB.Value = True Then
UbahData.Offset(0, 4).Value = "B"
End If
If Me.txtC.Value = True Then
UbahData.Offset(0, 4).Value = "C"
End If

'Machine
UbahData.Offset(0, 5).Value = Me.txtMachine.Value

'Category
UbahData.Offset(0, 6).Value = Me.txtCategory.Value

'Tube/Paddle/Side
UbahData.Offset(0, 7).Value = Me.txtTube.Value

'Alarm Message
UbahData.Offset(0, 8).Value = Me.txtAlarm.Value

'Problem
UbahData.Offset(0, 9).Value = Me.txtProblem.Value

'Action Taken
UbahData.Offset(0, 10).Value = Me.txtAction.Value

'Action By
Dim i As Long
Dim strActionBy As String

strActionBy = ""

For i = 0 To txtActionby.ListCount - 1
    If txtActionby.Selected(i) Then strActionBy = IIf(strActionBy = "", txtActionby.List(i), strActionBy & vbLf & txtActionby.List(i)) ' There is a space after comma for readability
Next i

UbahData.Offset(0, 11).Value = strActionBy

'Machine Status
If Me.txtUp.Value = True Then
UbahData.Offset(0, 12).Value = "Up"
End If
If Me.txtDown.Value = True Then
UbahData.Offset(0, 12).Value = "Down"
End If

'Uptime Downtime
UbahData.Offset(0, 13).Value = Me.txtDown1.Value
UbahData.Offset(0, 14).Value = Me.txtUp1.Value
UbahData.Offset(0, 15).Value = _
Abs(TimeValue(Me.txtUp1) - TimeValue(Me.txtDown1))

'Part Change
UbahData.Offset(0, 16).Value = Me.txtPart1.Value
Call MsgBox("Data Successfully Updated", vbInformation, "Data Update")
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
End If
Exit Sub
eRWIN:
Call MsgBox("Cannot Find Your Data", vbInformation, "Data Search")

Sheet6.Select
Dim lastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  lastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(lastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With

End Sub
Private Sub CommandButton4_Click()
Addon.Show
End Sub

Private Sub Delete_Click()
Dim Hapusdata As Object
If Me.txtNo.Value = "" Then
Call MsgBox("Choose Data To be Deleted", vbInformation, "Deleting Data")
Else
'Membuat pesan konfirmasi hapus data
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
'Menentukan tempat hapus data, menghapus data dan membersihkan form
Set Hapusdata = ActiveSheet.Range("A9:A40000").Find(What:=Me.txtNo.Value, LookIn:=xlValues)
Hapusdata.Offset(0, 0).ClearContents
Hapusdata.Offset(0, 1).ClearContents
Hapusdata.Offset(0, 2).ClearContents
Hapusdata.Offset(0, 3).ClearContents
Hapusdata.Offset(0, 4).ClearContents
Hapusdata.Offset(0, 5).ClearContents
Hapusdata.Offset(0, 6).ClearContents
Hapusdata.Offset(0, 7).ClearContents
Hapusdata.Offset(0, 8).ClearContents
Hapusdata.Offset(0, 9).ClearContents
Hapusdata.Offset(0, 10).ClearContents
Hapusdata.Offset(0, 11).ClearContents
Hapusdata.Offset(0, 12).ClearContents
Hapusdata.Offset(0, 13).ClearContents
Hapusdata.Offset(0, 14).ClearContents
Hapusdata.Offset(0, 15).ClearContents
Hapusdata.Offset(0, 16).ClearContents
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
Call Urut_Data
Me.txtSection.Enabled = True
Me.txtNo.Enabled = True
End If

Dim lastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  lastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(lastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
  
End Sub

Private Sub Exitt_Click()
Select Case MsgBox("Anda akan keluar dari Aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Private Sub Find_Click()
On Error GoTo Salah
Set Find_Data = Sheet6
Sheet3.Range("A1").Value = Me.SelDat.Value
Sheet3.Range("A2").Value = Me.Keyword.Value
Find_Data.Range("A8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet3.Range("A1:A2"), CopyTorange:=Sheet3.Range("C1:S1"), Unique:=False
Me.ListBox1.RowSource = Sheet3.Range("Search").Address(EXTERNAL:=True)
Exit Sub
Salah:
Call MsgBox("Maaf Data Tidak Ditemukan", vbInformation, "Cari Data")
End Sub

Private Sub Generate_Click()
UserForm1.Show
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo eRWIN
'Perintah memasukkan data dari ListBox ke TextBox

Me.txtNo.Value = Me.ListBox1.Column(0)
Me.txtSection.Value = Me.ListBox1.Column(1)
Me.txtDate.Value = Format(Me.ListBox1.Column(2), "Medium Date")

If Me.ListBox1.Column(3) = "Day" Then
Me.txtDay.Value = True
End If
If Me.ListBox1.Column(3) = "Night" Then
Me.txtNight.Value = True
End If

If Me.ListBox1.Column(4) = "A" Then
Me.txtA.Value = True
End If
If Me.ListBox1.Column(4) = "B" Then
Me.txtB.Value = True
End If
If Me.ListBox1.Column(4) = "C" Then
Me.txtC.Value = True
End If

Me.txtMachine.Value = Me.ListBox1.Column(5)
Me.txtCategory.Value = Me.ListBox1.Column(6)
Me.txtTube.Value = Me.ListBox1.Column(7)
Me.txtAlarm.Value = Me.ListBox1.Column(8)
Me.txtProblem.Value = Me.ListBox1.Column(9)
Me.txtAction.Value = Me.ListBox1.Column(10)

' Clear previous selections
Me.txtActionby.MultiSelect = fmMultiSelectSingle
Me.txtActionby.Value = ""
Me.txtActionby.MultiSelect = fmMultiSelectMulti

Dim i As Long
Dim strActionBy As String
Dim arr As Variant
Dim elem As Variant

strActionBy = ListBox1.List(ListBox1.ListIndex, 11)

arr = Split(strActionBy, vbLf)

For Each elem In arr
    For i = 0 To txtActionby.ListCount - 1
        If elem = txtActionby.List(i) Then
            txtActionby.Selected(i) = True
            Exit For
        End If
    Next i
Next elem

If Me.ListBox1.Column(12) = "Up" Then
Me.txtUp.Value = True
End If
If Me.ListBox1.Column(12) = "Down" Then
Me.txtDown.Value = True
End If

Me.txtDown1.Value = Format(Me.ListBox1.Column(13), "hh:mm")
Me.txtUp1.Value = Format(Me.ListBox1.Column(14), "hh:mm")
Me.txtPart1.Value = Me.ListBox1.Column(16)
Exit Sub
eRWIN:
Call MsgBox("Pilih data pada tabel data", vbInformation, "Data Siswa")
End Sub

Private Sub Reset_Click()
Me.txtProblem.Value = ""
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
Call Urut_Data
Me.txtSection.Enabled = True
Me.txtNo.Enabled = True
End Sub

Private Sub Reset1_Click()
ListBox1.RowSource = Sheet6.Range("Passdown").Address(EXTERNAL:=True)
Me.SelDat.Value = ""
Me.Keyword.Value = ""

End Sub

Private Sub Save_Click()
ThisWorkbook.Save
End Sub


Private Sub txtCategory_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")

Dim o As Integer

Me.txtProblem.Clear
For o = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
If sh.Range("B" & o).Value = "Problem" Then
    If sh.Range("D" & o) = Me.txtCategory.Value Then
        Me.txtProblem.AddItem sh.Range("C" & o)
    End If
End If
Next o
End Sub

Private Sub txtDown1_AfterUpdate()
Dim a As String
a = Len(Me.txtDown1)
On Error Resume Next
If a <= 2 Then
Me.txtDown1 = Left(Me.txtDown1, a) & ":" & 0
ElseIf a = 3 Then
Me.txtDown1 = Left(Me.txtDown1, 1) & ":" & Right(Me.txtDown1, 2)
Else
Me.txtDown1 = Left(Me.txtDown1, 2) & ":" & Right(Me.txtDown1, 2)
End If
Me.txtDown1 = Format(Me.txtDown1, "HH:MM")

End Sub



Private Sub txtSection_Change()
Dim sh As Worksheet
Dim shh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")
Set shh = ThisWorkbook.Sheets("Equipment 4")

Dim o As Integer
Dim i As Integer

Me.txtMachine.Clear
Me.txtTube.Clear
For o = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
If sh.Range("B" & o).Value = "Machine" Then
    If sh.Range("D" & o) = Me.txtSection.Value Then
        Me.txtMachine.AddItem sh.Range("C" & o)
    End If
End If
If sh.Range("B" & o).Value = "Module" Then
    If sh.Range("D" & o) = Me.txtSection.Value Then
        Me.txtTube.AddItem sh.Range("C" & o)
    End If
End If
Next o

Dim W As Worksheet
Set W = ThisWorkbook.Sheets("Equipment 4")
Dim R As Integer

Me.txtActionby.Clear
For R = 2 To W.Range("A" & Application.Rows.Count).End(xlUp).Row
If W.Range("B" & R).Value = "Employees" Then
    If W.Range("D" & R) = Me.txtSection.Value Then
        Me.txtActionby.AddItem W.Range("C" & R)
    End If
End If
Next R

End Sub

Private Sub txtTube_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")

Dim o As Integer

Me.txtCategory.Clear
For o = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
If sh.Range("B" & o).Value = "Problem Category" Then
    If sh.Range("D" & o) = Me.txtTube.Value Then
        Me.txtCategory.AddItem sh.Range("C" & o)
    End If
    End If
    Next o
End Sub
Private Sub txtUp1_AfterUpdate()
Dim a As String
a = Len(Me.txtUp1)
On Error Resume Next
If a <= 2 Then
Me.txtUp1 = Left(Me.txtUp1, a) & ":" & 0
ElseIf a = 3 Then
Me.txtUp1 = Left(Me.txtUp1, 1) & ":" & Right(Me.txtUp1, 2)
Else
Me.txtUp1 = Left(Me.txtUp1, 2) & ":" & Right(Me.txtUp1, 2)
End If
Me.txtUp1 = Format(Me.txtUp1, "HH:MM")
End Sub


Private Sub UserForm_Activate()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")

Dim i As Integer

Me.txtSection.Clear

For i = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
    If sh.Range("B" & i).Value = "Section" Then
        Me.txtSection.AddItem sh.Range("C" & i)
    End If
Next i

With SelDat
.AddItem "Machine"
.AddItem "Category"
.AddItem "Module/Channel"
.AddItem "Machine Status"
.AddItem "Problems"
.AddItem "Section"
End With

On Error Resume Next
Sheet6.Select
Me.ListBox1.RowSource = Sheet6.Range("Passdown").Address(EXTERNAL:=True)
End Sub
 
Upvote 0
Cyril Beki said:
VBA Code: 
Private Sub Add_Click()

Dim text As Object
Set text = Sheet6.Range("A5000").End(xlUp)

If txtDown1.Value = "" Then
MsgBox "Fill in the Downtime", vbCritical
Exit Sub
End If

If txtUp1.Value = "" Then
MsgBox "Fill in the Uptime", vbCritical
Exit Sub
End If

Select Case MsgBox("You will saved the recent data" _
& vbCrLf & "Are you sure?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Adding Data")
Case vbNo
Exit Sub
Case vbYes
End Select

'Numbering
Me.txtNo.Value = "=Row()-1"

'Adding command
text.Offset(1, 0).Value = Me.txtNo.Value
text.Offset(1, 1).Value = Me.txtSection.Value
text.Offset(1, 2).Value = Me.txtDate.Value

'Day/Night
If Me.txtDay.Value = True Then
text.Offset(1, 3).Value = "Day"
End If
If Me.txtNight.Value = True Then
text.Offset(1, 3).Value = "Night"
End If

'Shift
If Me.txtA.Value = True Then
text.Offset(1, 4).Value = "A"
End If
If Me.txtB.Value = True Then
text.Offset(1, 4).Value = "B"
End If
If Me.txtC.Value = True Then
text.Offset(1, 4).Value = "C"
End If

'Machine
text.Offset(1, 5).Value = Me.txtMachine.Value

'Category
text.Offset(1, 6).Value = Me.txtCategory.Value

'Tube/Paddle/Side
text.Offset(1, 7).Value = Me.txtTube.Value

'Alarm Message
text.Offset(1, 8).Value = Me.txtAlarm.Value

'Problem
text.Offset(1, 9).Value = Me.txtProblem.Value

'Action Taken
text.Offset(1, 10).Value = Me.txtAction.Value

'Action By
Dim i As Long
Dim strActionBy As String

strActionBy = ""

For i = 0 To txtActionby.ListCount - 1
    If txtActionby.Selected(i) Then strActionBy = IIf(strActionBy = "", txtActionby.List(i), strActionBy & vbLf & txtActionby.List(i)) ' There is a space after comma for readability
Next i

text.Offset(1, 11).Value = strActionBy

'Machine Status
If Me.txtUp.Value = True Then
text.Offset(1, 12).Value = "Up"
End If
If Me.txtDown.Value = True Then
text.Offset(1, 12).Value = "Down"
End If

'Uptime Downtime
text.Offset(1, 13).Value = Me.txtDown1.Value
text.Offset(1, 14).Value = Me.txtUp1.Value
text.Offset(1, 15).Value = _
Abs(TimeValue(Me.txtUp1) - TimeValue(Me.txtDown1))

'Part Change
text.Offset(1, 16).Value = Me.txtPart1.Value

Sheet6.Select
Me.ListBox1.RowSource = Sheet6.Range("Passdown").Address(EXTERNAL:=True)
MsgBox ("Data is added succesfully")

'Clear form after add
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""

Sheet6.Select
Dim lastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  lastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(lastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
 
End Sub
Private Sub CommandButton1_Click()
txtDate.Value = Format(Date, "Medium Date")
End Sub

Private Sub CommandButton2_Click()
txtDate.Value = Format(Date - 1, "Medium Date")
End Sub

Private Sub Update_Click()
On Error GoTo eRWIN
Dim UbahData As Object

If txtDown1.Value = "" Then
MsgBox "Fill in the Downtime", vbCritical
Exit Sub
End If

If txtUp1.Value = "" Then
MsgBox "Fill in the Uptime", vbCritical
Exit Sub
End If

If Me.txtNo.Value = "" Then
Call MsgBox("Select The Data", vbInformation, "Data Update")
Else
Set UbahData = Sheet6.Range("A9:A10000").Find(What:=Me.txtNo.Value, LookIn:=xlValues)

'Section
UbahData.Offset(0, 1).Value = Me.txtSection.Value

'Date
UbahData.Offset(0, 2).Value = Me.txtDate.Value


'Day/Night
If Me.txtDay.Value = True Then
UbahData.Offset(0, 3).Value = "Day"
End If
If Me.txtNight.Value = True Then
UbahData.Offset(0, 3).Value = "Night"
End If

'Shift
If Me.txtA.Value = True Then
UbahData.Offset(0, 4).Value = "A"
End If
If Me.txtB.Value = True Then
UbahData.Offset(0, 4).Value = "B"
End If
If Me.txtC.Value = True Then
UbahData.Offset(0, 4).Value = "C"
End If

'Machine
UbahData.Offset(0, 5).Value = Me.txtMachine.Value

'Category
UbahData.Offset(0, 6).Value = Me.txtCategory.Value

'Tube/Paddle/Side
UbahData.Offset(0, 7).Value = Me.txtTube.Value

'Alarm Message
UbahData.Offset(0, 8).Value = Me.txtAlarm.Value

'Problem
UbahData.Offset(0, 9).Value = Me.txtProblem.Value

'Action Taken
UbahData.Offset(0, 10).Value = Me.txtAction.Value

'Action By
Dim i As Long
Dim strActionBy As String

strActionBy = ""

For i = 0 To txtActionby.ListCount - 1
    If txtActionby.Selected(i) Then strActionBy = IIf(strActionBy = "", txtActionby.List(i), strActionBy & vbLf & txtActionby.List(i)) ' There is a space after comma for readability
Next i

UbahData.Offset(0, 11).Value = strActionBy

'Machine Status
If Me.txtUp.Value = True Then
UbahData.Offset(0, 12).Value = "Up"
End If
If Me.txtDown.Value = True Then
UbahData.Offset(0, 12).Value = "Down"
End If

'Uptime Downtime
UbahData.Offset(0, 13).Value = Me.txtDown1.Value
UbahData.Offset(0, 14).Value = Me.txtUp1.Value
UbahData.Offset(0, 15).Value = _
Abs(TimeValue(Me.txtUp1) - TimeValue(Me.txtDown1))

'Part Change
UbahData.Offset(0, 16).Value = Me.txtPart1.Value
Call MsgBox("Data Successfully Updated", vbInformation, "Data Update")
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
End If
Exit Sub
eRWIN:
Call MsgBox("Cannot Find Your Data", vbInformation, "Data Search")

Sheet6.Select
Dim lastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  lastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(lastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With

End Sub
Private Sub CommandButton4_Click()
Addon.Show
End Sub

Private Sub Delete_Click()
Dim Hapusdata As Object
If Me.txtNo.Value = "" Then
Call MsgBox("Choose Data To be Deleted", vbInformation, "Deleting Data")
Else
'Membuat pesan konfirmasi hapus data
Select Case MsgBox("Anda akan menghapus data" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Hapus data")
Case vbNo
Exit Sub
Case vbYes
End Select
'Menentukan tempat hapus data, menghapus data dan membersihkan form
Set Hapusdata = ActiveSheet.Range("A9:A40000").Find(What:=Me.txtNo.Value, LookIn:=xlValues)
Hapusdata.Offset(0, 0).ClearContents
Hapusdata.Offset(0, 1).ClearContents
Hapusdata.Offset(0, 2).ClearContents
Hapusdata.Offset(0, 3).ClearContents
Hapusdata.Offset(0, 4).ClearContents
Hapusdata.Offset(0, 5).ClearContents
Hapusdata.Offset(0, 6).ClearContents
Hapusdata.Offset(0, 7).ClearContents
Hapusdata.Offset(0, 8).ClearContents
Hapusdata.Offset(0, 9).ClearContents
Hapusdata.Offset(0, 10).ClearContents
Hapusdata.Offset(0, 11).ClearContents
Hapusdata.Offset(0, 12).ClearContents
Hapusdata.Offset(0, 13).ClearContents
Hapusdata.Offset(0, 14).ClearContents
Hapusdata.Offset(0, 15).ClearContents
Hapusdata.Offset(0, 16).ClearContents
Call MsgBox("Data berhasil dihapus", vbInformation, "Hapus Data")
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
Call Urut_Data
Me.txtSection.Enabled = True
Me.txtNo.Enabled = True
End If

Dim lastRow As Long, LastCol As Long
  Cells.Borders.LineStyle = xlNone
  lastRow = Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
  LastCol = Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
  With Range("A8", Cells(lastRow, LastCol))
    .BorderAround xlDouble
    .Rows.Borders(xlInsideHorizontal).LineStyle = xlDash
    .Rows.Borders(xlInsideVertical).LineStyle = xlContinuous
    .Columns.AutoFit
  End With
 
End Sub

Private Sub Exitt_Click()
Select Case MsgBox("Anda akan keluar dari Aplikasi" _
& vbCrLf & "Apakah anda yakin?" _
, vbYesNo Or vbQuestion Or vbDefaultButton1, "Keluar")
Case vbNo
Exit Sub
Case vbYes
End Select
ThisWorkbook.Save
ThisWorkbook.Close
End Sub

Private Sub Find_Click()
On Error GoTo Salah
Set Find_Data = Sheet6
Sheet3.Range("A1").Value = Me.SelDat.Value
Sheet3.Range("A2").Value = Me.Keyword.Value
Find_Data.Range("A8").CurrentRegion.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
Sheet3.Range("A1:A2"), CopyTorange:=Sheet3.Range("C1:S1"), Unique:=False
Me.ListBox1.RowSource = Sheet3.Range("Search").Address(EXTERNAL:=True)
Exit Sub
Salah:
Call MsgBox("Maaf Data Tidak Ditemukan", vbInformation, "Cari Data")
End Sub

Private Sub Generate_Click()
UserForm1.Show
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
On Error GoTo eRWIN
'Perintah memasukkan data dari ListBox ke TextBox

Me.txtNo.Value = Me.ListBox1.Column(0)
Me.txtSection.Value = Me.ListBox1.Column(1)
Me.txtDate.Value = Format(Me.ListBox1.Column(2), "Medium Date")

If Me.ListBox1.Column(3) = "Day" Then
Me.txtDay.Value = True
End If
If Me.ListBox1.Column(3) = "Night" Then
Me.txtNight.Value = True
End If

If Me.ListBox1.Column(4) = "A" Then
Me.txtA.Value = True
End If
If Me.ListBox1.Column(4) = "B" Then
Me.txtB.Value = True
End If
If Me.ListBox1.Column(4) = "C" Then
Me.txtC.Value = True
End If

Me.txtMachine.Value = Me.ListBox1.Column(5)
Me.txtCategory.Value = Me.ListBox1.Column(6)
Me.txtTube.Value = Me.ListBox1.Column(7)
Me.txtAlarm.Value = Me.ListBox1.Column(8)
Me.txtProblem.Value = Me.ListBox1.Column(9)
Me.txtAction.Value = Me.ListBox1.Column(10)

' Clear previous selections
Me.txtActionby.MultiSelect = fmMultiSelectSingle
Me.txtActionby.Value = ""
Me.txtActionby.MultiSelect = fmMultiSelectMulti

Dim i As Long
Dim strActionBy As String
Dim arr As Variant
Dim elem As Variant

strActionBy = ListBox1.List(ListBox1.ListIndex, 11)

arr = Split(strActionBy, vbLf)

For Each elem In arr
    For i = 0 To txtActionby.ListCount - 1
        If elem = txtActionby.List(i) Then
            txtActionby.Selected(i) = True
            Exit For
        End If
    Next i
Next elem

If Me.ListBox1.Column(12) = "Up" Then
Me.txtUp.Value = True
End If
If Me.ListBox1.Column(12) = "Down" Then
Me.txtDown.Value = True
End If

Me.txtDown1.Value = Format(Me.ListBox1.Column(13), "hh:mm")
Me.txtUp1.Value = Format(Me.ListBox1.Column(14), "hh:mm")
Me.txtPart1.Value = Me.ListBox1.Column(16)
Exit Sub
eRWIN:
Call MsgBox("Pilih data pada tabel data", vbInformation, "Data Siswa")
End Sub

Private Sub Reset_Click()
Me.txtProblem.Value = ""
Me.txtNo.Value = ""
Me.txtDate.Value = ""
Me.txtSection.Value = ""
Me.txtMachine.Value = ""
Me.txtCategory.Value = ""
Me.txtTube.Value = ""
Me.txtAlarm.Value = ""
Me.txtProblem.Value = ""
Me.txtAction.Value = ""
Me.txtActionby.Value = ""
Me.txtPart1.Value = ""
Me.txtDay.Value = False
Me.txtNight.Value = False
Me.txtA.Value = False
Me.txtB.Value = False
Me.txtC.Value = False
Me.txtUp.Value = False
Me.txtDown.Value = False
Me.txtDown1.Value = ""
Me.txtUp1.Value = ""
Call Urut_Data
Me.txtSection.Enabled = True
Me.txtNo.Enabled = True
End Sub

Private Sub Reset1_Click()
ListBox1.RowSource = Sheet6.Range("Passdown").Address(EXTERNAL:=True)
Me.SelDat.Value = ""
Me.Keyword.Value = ""

End Sub

Private Sub Save_Click()
ThisWorkbook.Save
End Sub


Private Sub txtCategory_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")

Dim o As Integer

Me.txtProblem.Clear
For o = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
If sh.Range("B" & o).Value = "Problem" Then
    If sh.Range("D" & o) = Me.txtCategory.Value Then
        Me.txtProblem.AddItem sh.Range("C" & o)
    End If
End If
Next o
End Sub

Private Sub txtDown1_AfterUpdate()
Dim a As String
a = Len(Me.txtDown1)
On Error Resume Next
If a <= 2 Then
Me.txtDown1 = Left(Me.txtDown1, a) & ":" & 0
ElseIf a = 3 Then
Me.txtDown1 = Left(Me.txtDown1, 1) & ":" & Right(Me.txtDown1, 2)
Else
Me.txtDown1 = Left(Me.txtDown1, 2) & ":" & Right(Me.txtDown1, 2)
End If
Me.txtDown1 = Format(Me.txtDown1, "HH:MM")

End Sub



Private Sub txtSection_Change()
Dim sh As Worksheet
Dim shh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")
Set shh = ThisWorkbook.Sheets("Equipment 4")

Dim o As Integer
Dim i As Integer

Me.txtMachine.Clear
Me.txtTube.Clear
For o = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
If sh.Range("B" & o).Value = "Machine" Then
    If sh.Range("D" & o) = Me.txtSection.Value Then
        Me.txtMachine.AddItem sh.Range("C" & o)
    End If
End If
If sh.Range("B" & o).Value = "Module" Then
    If sh.Range("D" & o) = Me.txtSection.Value Then
        Me.txtTube.AddItem sh.Range("C" & o)
    End If
End If
Next o

Dim W As Worksheet
Set W = ThisWorkbook.Sheets("Equipment 4")
Dim R As Integer

Me.txtActionby.Clear
For R = 2 To W.Range("A" & Application.Rows.Count).End(xlUp).Row
If W.Range("B" & R).Value = "Employees" Then
    If W.Range("D" & R) = Me.txtSection.Value Then
        Me.txtActionby.AddItem W.Range("C" & R)
    End If
End If
Next R

End Sub

Private Sub txtTube_Change()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")

Dim o As Integer

Me.txtCategory.Clear
For o = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
If sh.Range("B" & o).Value = "Problem Category" Then
    If sh.Range("D" & o) = Me.txtTube.Value Then
        Me.txtCategory.AddItem sh.Range("C" & o)
    End If
    End If
    Next o
End Sub
Private Sub txtUp1_AfterUpdate()
Dim a As String
a = Len(Me.txtUp1)
On Error Resume Next
If a <= 2 Then
Me.txtUp1 = Left(Me.txtUp1, a) & ":" & 0
ElseIf a = 3 Then
Me.txtUp1 = Left(Me.txtUp1, 1) & ":" & Right(Me.txtUp1, 2)
Else
Me.txtUp1 = Left(Me.txtUp1, 2) & ":" & Right(Me.txtUp1, 2)
End If
Me.txtUp1 = Format(Me.txtUp1, "HH:MM")
End Sub


Private Sub UserForm_Activate()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Machine Problems")

Dim i As Integer

Me.txtSection.Clear

For i = 2 To sh.Range("A" & Application.Rows.Count).End(xlUp).Row
    If sh.Range("B" & i).Value = "Section" Then
        Me.txtSection.AddItem sh.Range("C" & i)
    End If
Next i

With SelDat
.AddItem "Machine"
.AddItem "Category"
.AddItem "Module/Channel"
.AddItem "Machine Status"
.AddItem "Problems"
.AddItem "Section"
End With

On Error Resume Next
Sheet6.Select
Me.ListBox1.RowSource = Sheet6.Range("Passdown").Address(EXTERNAL:=True)
End Sub
Click to expand...
Below is the module code
VBA Code: 
Sub Urut_Data()
Application.ScreenUpdating = False
ActiveSheet.Select
ActiveSheet.Range("A8:Q20000").Sort key1:=Range("A8"), order1:=xlAscending, Header:=xlYes
End Sub
 
Upvote 0
Cyril Beki said:
Below is the module code
VBA Code: 
Sub Urut_Data()
Application.ScreenUpdating = False
ActiveSheet.Select
ActiveSheet.Range("A8:Q20000").Sort key1:=Range("A8"), order1:=xlAscending, Header:=xlYes
End Sub
Click to expand...
Wow. That is a lot of code and since I'm not sure what your objective is I can probable not be able to help you.
 
Upvote 0
To clear all your controls on the Userform you could use a short script like this.
VBA Code: 
Private Sub CommandButton2_Click()
'Modified  9/29/2021  4:04:40 PM  EDT
Dim ctrl As MSForms.Control
 
For Each ctrl In Me.Controls
    Select Case True
        Case TypeOf ctrl Is MSForms.CheckBox
            ctrl.Value = False
        Case TypeOf ctrl Is MSForms.TextBox
            ctrl.Value = ""
        Case TypeOf ctrl Is MSForms.ComboBox
            ctrl.Value = ""
    End Select
    
Next ctrl
End Sub
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Record (Row) Locking in Excel
Replies
6
Views
295
Jeffrey Mahoney
Jeffrey Mahoney
C
  • Question Question
Searching using TextBox and ListBox
Replies
1
Views
213
campbell1093
C
C
  • Question Question
Excel Userform Listbox Search issues
Replies
3
Views
731
Akuini
Akuini
J
  • Question Question
Struggling on Userform that has four functions, searching, editing, adding, and deleting.
Replies
7
Views
447
dmt32
D
I
  • Solved
Code not formatting correctly in textbox userform
2 3
Replies
22
Views
720
MARK858
MARK858

Forum statistics

Threads
1,223,702
Messages
6,173,950
Members
452,539
Latest member
delvey

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top