SEARCH ENGINE AND DELETE COMMAND

[krishnaa_kumarr88]

HI,

I created a userform with multiple options. I got stuck in few places. Please help me if you know.

If you see the attachment, and once you open the attachment it will automatically direct you to the TPM form. Please close TPM form.
1. In the Sheet 1(I named as TPM FORM) double click on any row which highlighed in red.
2.It open EDIT FORM. I have problem with the red highlighed area in the EDIT FORM. That is i have problem in searching Machine name, List box and delete option.
3. What i need is once i start typing any alphabet in the MACHINE NAME it should automatically pull up all the machine with the same alphabet from the sheet and should be shown in the list box , so that i can click and delete the one which i dont want.

Does any one have idea of how to do it ?
thanks

[HansV]

You haven't told us what you want to fill the list box with (it has 6 columns), but here is an example:

Code: Select all

Private Sub Week111_Change()
    Dim wsh As Worksheet
    Dim r As Long
    Dim m As Long
    Dim n As Long
    Me.lbxDetails.Clear
    Set wsh = Worksheets("TPM FORM")
    m = wsh.Cells(wsh.Rows.Count, 5).End(xlUp).Row
    For r = 24 To m
        If UCase(wsh.Cells(r, 5).Value) Like UCase(Me.Week111) & "*" Then
            Me.lbxDetails.AddItem wsh.Cells(r, 1).Value
            Me.lbxDetails.List(n, 1) = Cells(r, 2).Value
            Me.lbxDetails.List(n, 2) = Cells(r, 3).Value
            Me.lbxDetails.List(n, 3) = Cells(r, 4).Value
            Me.lbxDetails.List(n, 4) = Cells(r, 5).Value
            Me.lbxDetails.List(n, 5) = Cells(r, 6).Value
            n = n + 1
        End If
    Next r
End Sub

The code for the Delete button:

Code: Select all

Private Sub DELETE_Click()
    If Me.lbxDetails.ListIndex > -1 Then
        Worksheets("TPM FORM").Cells(Me.lbxDetails, 1).EntireRow.DELETE
    End If
End Sub

Remove lbxDetails_Click! Otherwise you'll get an error message when you select a machine.

[krishnaa_kumarr88]

BRILLIANT ..THANKS A LOT. BUT DELETE COMMAND BUTTON IS NOT WORKING.
DO YOU KNOW WHY?
PLEASE CHECK THE ATTACHMENT

THANKS

[HansV]

Try changing the line

Code: Select all

            Me.lbxDetails.AddItem wsh.Cells(r, 1).Value

to

Code: Select all

            Me.lbxDetails.AddItem r

(We need to know the row number of the row that should be deleted)

[krishnaa_kumarr88]

Thats works, but the problem is that code is deleting all the row one by one irrespective of what i am selecting.

[HansV]

When I try it, only the row corresponding to the one selected in the list box is deleted...

[krishnaa_kumarr88]

Say example,
when i search different machine through Machine name, it populate all the machine start with that name. Say example if we get 10 items in the list. If i select one among those 10 items from the list and if i click delete that particular item is deleted from the spreadsheet but its still showing in the listbox in the form. If i click delete again , then the next row in the spreadsheet is deleted. Simillarly if i do it for 10 times , all the 10 items getting deleted.

[HansV]

Ah, I understand now. Change the code for the Delete button as follows:

Code: Select all

Private Sub DELETE_Click()
    If Me.lbxDetails.ListIndex > -1 Then
        Worksheets("TPM FORM").Cells(Me.lbxDetails, 1).EntireRow.DELETE
        Me.lbxDetails.RemoveItem Me.lbxDetails.ListIndex
    End If
End Sub

The item will be removed from the list box as well as from the worksheet.

[krishnaa_kumarr88]

Thanks a lot.
I am just wondering is it possible to do the following thing in my spreadsheet.
Say example, After selecting the list from the listbox from the userform (which in red colour ) , is it possible to display the same selected data or row in the left hand side of the form which are in grey colour.

[HansV]

Populating the left hand side will cause Week11 to change, and this in turn will clear, then repopulate the list box. That doesn't seem like a good idea to me.

[krishnaa_kumarr88]

hmmmm :(
anyway thanks

[HansV]

You could do it like this - the following code replaces all the code of EDITFORM:

Code: Select all

Option Explicit

Private blnStop As Boolean

Private Sub Clear_Click()
    Me.ComboBox11.Value = ""
    Me.Week11.Value = ""
    Me.Week22.Value = ""
    Me.PGNumber.Value = ""
    Me.Machine.Value = ""
    Me.TPM.Value = ""
    Me.Result2.Value = ""
    Me.Result1.Value = ""
    Me.Comments.Value = ""
    Cells(ActiveCell.Row, 7).Value = ""
    Cells(ActiveCell.Row, 6).Value = ""
    Cells(ActiveCell.Row, 9).Value = ""
    Cells(ActiveCell.Row, 10).Value = ""
End Sub

Private Sub ComboBox1_Change()
    Select Case ComboBox1.Value
        Case "AIRBUS"
            Machine.RowSource = "ADDNEW!D7: D100"
        Case "GCU"
            Machine.RowSource = "ADDNEW!G7:G100"
        Case "FALCON"
            Machine.RowSource = "ADDNEW!I7:I100"
        Case "AC"
            Machine.RowSource = "ADDNEW!K7:K100"
        Case "DC"
            Machine.RowSource = "ADDNEW!M7:M100"
        Case "MRO"
            Machine.RowSource = "ADDNEW!O7:O100"
    End Select
End Sub

Private Sub CommandButton1_Click()
    Cells(ActiveCell.Row, 1).Value = ComboBox11.Value
    Cells(ActiveCell.Row, 2).Value = Week11.Value
    Cells(ActiveCell.Row, 3).Value = Week22.Value
    Cells(ActiveCell.Row, 4).Value = PGNumber.Value
    Cells(ActiveCell.Row, 5).Value = Machine.Value
    Cells(ActiveCell.Row, 6).Value = TPM.Value
    If Result2.Value = True Then
        Cells(ActiveCell.Row, 7).Value = "REQUIRES ATTENTION"
        Cells(ActiveCell.Row, 8).Value = ""
    End If
    If Result1.Value = True Then
        Cells(ActiveCell.Row, 8).Value = "OK"
        Cells(ActiveCell.Row, 7).Value = ""
        Cells(ActiveCell.Row, 11) = Now
    End If
    Cells(ActiveCell.Row, 9).Value = Comments.Value
    Me.Hide
End Sub

Private Sub CommandButton2_Click()
    Me.Hide
End Sub

Private Sub DELETE_Click()
    If Me.lbxDetails.ListIndex > -1 Then
        Worksheets("TPM FORM").Cells(Me.lbxDetails, 1).EntireRow.DELETE
        Me.lbxDetails.RemoveItem Me.lbxDetails.ListIndex
    End If
End Sub

Private Sub lbxDetails_Click()
    Dim r As Long
    blnStop = True
    r = Me.lbxDetails
    Me.ComboBox11.Value = Cells(r, 1)
    Me.Week11.Value = Cells(r, 2)
    Me.Week22.Value = Cells(r, 3)
    Me.PGNumber.Value = Cells(r, 4)
    Me.Machine.Value = Cells(r, 5)
    Me.TPM.Value = Cells(r, 6)
    If Cells(r, 7) <> "" Then Me.Result2.Value = True
    If Cells(r, 8) <> "" Then Me.Result1.Value = True
    Me.Comments.Value = Cells(r, 9)
    blnStop = False
End Sub

Private Sub Machine_Change()
    Select Case Machine.Value
        Case "SELECT ALL"
            PGNumber.Value = "SELECT ALL"
            TPM.Value = "SELECT ALL"
        Case "CTX500B TURNING MACHINE 1"
            PGNumber.Value = "PG 0034"
            TPM.Value = "TPM 0034"
        Case "HAAS(VF4)"
            PGNumber.Value = "PG 0035"
            TPM.Value = "TPM 0035"
        Case "CTX 500B TURNING MACHINE 2"
            PGNumber.Value = "PG 0038"
            TPM.Value = "TPM 0038"
        Case "HF500(SIGMA)"
            PGNumber.Value = "PG 0039"
            TPM.Value = "TPM 0039"
        Case "HAAS(VF4 BCE)"
            PGNumber.Value = "PG 0040"
            TPM.Value = "TPM 0040"
        Case "JONES & SHIPMEN (1096 CNC)"
            PGNumber.Value = "PG 0238"
            TPM.Value = "TPM 0238"
        Case "EFD INDUCTION LIMITED"
            PGNumber.Value = "PG 0242"
            TPM.Value = "TPM 0242"
        Case "TECHNICA(5100-810)"
            PGNumber.Value = "PG 0243"
            TPM.Value = "TPM 0243"
        Case "JUNG BERLIN D220"
            PGNumber.Value = "PG 0244"
            TPM.Value = "TPM 0244"
        Case "JONES & SHIPMEN (1074)"
            PGNumber.Value = "PG 0247"
            TPM.Value = "TPM 0247"
        Case "BALANCING MACHINE"
            PGNumber.Value = "PG 0248"
            TPM.Value = "TPM 0248"
        Case "ROTARY 1 SCHENCK BALANCER"
            PGNumber.Value = "PG 0249"
            TPM.Value = "TPM 0249"
        Case "ROTOR BALANCE ASSEMBLY(SCHENCK)"
            PGNumber.Value = "PG 0250"
            TPM.Value = "TPM 0250"
        Case "STUDER1 S33"
            PGNumber.Value = "PG 0525"
            TPM.Value = "TPM 0525"
        Case "POLLARD"
            PGNumber.Value = "PG 0584"
            TPM.Value = "TPM 0584"
        Case "STUDER2 S33"
            PGNumber.Value = "PG 0972"
            TPM.Value = "TPM 0972"
        Case "PETROFERM"
            PGNumber.Value = "PG 0995"
            TPM.Value = "TPM 0995"
        Case "PCB DRILLING MACHINE"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "POP RIVETER"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "SQUEEZE RIVETER"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "PILLAR DRILL"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "GRINDER"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "LINISHER"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "CATE TEST INTERFACE(CATE 3)"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "CATE- ONLY INTERFACE FOR A380"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "VACUUM PUMP (BELL JAR)"
            PGNumber.Value = "NOT APPLICABLE"
            TPM.Value = "NOT APPLICABLE"
        Case "CLOSED LOOP TEST RIG"
            PGNumber.Value = "PG 0081"
            TPM.Value = "NOT APPLICABLE"
        Case "CLEANING TANK"
            PGNumber.Value = "PG 0496"
            TPM.Value = "NOT APPLICABLE"
        Case "CATE RIG (CONFIGURABLE AUTOMATIC TEST EQUIPMENT 1)"
            PGNumber.Value = "PG 0618"
            TPM.Value = "NOT APPLICABLE"
        Case "CATE RIG (CONFIGURABLE AUTOMATIC TEST EQUIPMENT 2)"
            PGNumber.Value = "PG 0619"
            TPM.Value = "NOT APPLICABLE"
        Case "LABORATORY OVEN(CONTROL SYSTEMS GCU TEST)"
            PGNumber.Value = "PG 0620"
            TPM.Value = "NOT APPLICABLE"
        Case "WASHER 1"
            PGNumber.Value = "PG 0621"
            TPM.Value = "NOT APPLICABLE"
        Case "MIDATA TEST RIG"
            PGNumber.Value = "PG 0624"
            TPM.Value = "NOT APPLICABLE"
        Case "ESS CHAMBER 1"
            PGNumber.Value = "PG 0633"
            TPM.Value = "NOT APPLICABLE"
        Case "ESS CHAMBER 2"
            PGNumber.Value = "PG 0635"
            TPM.Value = "NOT APPLICABLE"
        Case "CATE RIG-GCU (CONFIGURABLE AUTOMATIC TEST EQUIPMENT)"
            PGNumber.Value = "PG 0637"
            TPM.Value = "TPM 0637"
        Case "UMATE 1"
            PGNumber.Value = "PG 0642"
            TPM.Value = "NOT APPLICABLE"
        Case "UMATE 2(a)"
            PGNumber.Value = "PG 0643"
            TPM.Value = "NOT APPLICABLE"
        Case "UMATE 2(b)"
            PGNumber.Value = "PG 0644"
            TPM.Value = "NOT APPLICABLE"
        Case "OVEN 1"
            PGNumber.Value = "PG 0645"
            TPM.Value = "NOT APPLICABLE"
        Case "OVEN 2"
            PGNumber.Value = "PG 0646"
            TPM.Value = "NOT APPLICABLE"
        Case "WASHER 2"
            PGNumber.Value = "PG 0647"
            TPM.Value = "NOT APPLICABLE"
        Case "DIP TANK ISOLATOR"
            PGNumber.Value = "PG 0648"
            TPM.Value = "NOT APPLICABLE"
        Case "DIPPING M/C HUMISEAL VARNISH"
            PGNumber.Value = "PG 0649"
            TPM.Value = "NOT APPLICABLE"
        Case "GRAVO GRAPH"
            PGNumber.Value = "PG 0650"
            TPM.Value = "NOT APPLICABLE"
        Case "LABORATORY OVEN"
            PGNumber.Value = "PG 0662"
            TPM.Value = "NOT APPLICABLE"
        Case "CATE RIG 5 - CONFIGURABLE AUTOMATIC TEST EQUIPMENT"
            PGNumber.Value = "PG 0664"
            TPM.Value = "TPM 0672"
        Case "GCU VIBRATION TEST RIG -LDS(AIRBUS AND GLOBAL)"
            PGNumber.Value = "PG 0718"
            TPM.Value = "NOT APPLICABLE"
        Case "POWER AMPLIFIER"
            PGNumber.Value = "PG 0719"
            TPM.Value = "NOT APPLICABLE"
        Case "EXTERNAL POWER FOR A380"
            PGNumber.Value = "PG 0981"
            TPM.Value = "NOT APPLICABLE"
        Case "CATE RIG (CONFIGURABLE AUTOMATIC TEST EQUIPMENT)"
            PGNumber.Value = "PG 0982"
            TPM.Value = "TPM 0083"
        Case "EXTERNAL POWER SUPPLY FOR A380/A400M"
            PGNumber.Value = "PG 0983"
            TPM.Value = "NOT APPLICABLE"
        Case "POWER SUPPLY OUTPUTS"
            PGNumber.Value = "PG 0989"
            TPM.Value = "NOT APPLICABLE"
        Case "BELL BUR-IN RIG"
            PGNumber.Value = "PG 0990"
            TPM.Value = "NOT APPLICABLE"
        Case "VOLTAGE DROP TESTER"
            PGNumber.Value = "PG 0995"
            TPM.Value = "NOT APPLICABLE"
        Case "3 PHASE POWER SUPPLY FOR A380 CATE"
            PGNumber.Value = "PG 0997"
            TPM.Value = "NOT APPLICABLE"
    End Select
End Sub

Private Sub Result1_Click()
    If Result1.Value = True Then
        Result2.Value = False
    End If
End Sub

Private Sub Result2_Click()
    If Result2.Value = True Then
        Result1.Value = False
    End If
End Sub

Private Sub UserForm_Initialize()
    Me.Top = Application.Top + 25
    Me.Left = Application.Left + 25
End Sub

Private Sub Week11_Change()
    Dim r As Range, rAll As Range, rList As Range
    Dim sTerm As String, sTerm2 As String
    Dim irow As Integer, icol As Integer

    If blnStop Then Exit Sub
    sTerm = Me.Week11
    Me.lbxDetails.Clear

    With Sheets("TPM FORM")
        Set rList = .Cells.Find("WEEK COMMENCING")
        If Not rList Is Nothing Then
            irow = rList.Row + 1
            icol = rList.Column
            Set rAll = .Range(.Cells(irow, icol), .Cells(irow, icol).End(xlDown))
            For Each r In rAll
                If InStr(r, sTerm) Then
                    With Me.lbxDetails
                        .AddItem r 'Week Commence Date
                        .List(.ListCount - 1, 1) = r.Offset(0, 1) 'Week End Date
                        .List(.ListCount - 1, 2) = r.Offset(0, 2) 'Machine Name
                        .List(.ListCount - 1, 3) = r.Offset(0, 3) 'PG Number
                        .List(.ListCount - 1, 4) = r.Offset(0, 4) 'TPM Number
                        .List(.ListCount - 1, 5) = r.Offset(0, 5) 'Result
                        .List(.ListCount - 1, 6) = r.Offset(0, 6) 'Comments
                    End With
                End If
            Next r
        End If
    End With
End Sub

Private Sub Week111_Change()
    Dim wsh As Worksheet
    Dim r As Long
    Dim m As Long
    Dim n As Long
    Me.lbxDetails.Clear
    Set wsh = Worksheets("TPM FORM")
    m = wsh.Cells(wsh.Rows.Count, 5).End(xlUp).Row
    For r = 24 To m
        If UCase(wsh.Cells(r, 5).Value) Like UCase(Me.Week111) & "*" Then
            Me.lbxDetails.AddItem r
            Me.lbxDetails.List(n, 1) = Cells(r, 2).Value
            Me.lbxDetails.List(n, 2) = Cells(r, 3).Value
            Me.lbxDetails.List(n, 3) = Cells(r, 4).Value
            Me.lbxDetails.List(n, 4) = Cells(r, 5).Value
            Me.lbxDetails.List(n, 5) = Cells(r, 6).Value
            n = n + 1
        End If
    Next r
End Sub

(I have made the indentation more consistent)

[krishnaa_kumarr88]

brilliant. thanks

[krishnaa_kumarr88]

Brilliant . Its working fine. Do you know why the date format is different for spreadsheet and for the form.
Example in spreadsheet row its showing dd/mm/yy
but in form its showing mm/dd/yy

[HansV]

Because VBA always uses USA date format mm/dd/yy. Try changing the CommandButton1_Click event procedure to

Code: Select all

Private Sub CommandButton1_Click()
    Cells(ActiveCell.Row, 1).Value = ComboBox11.Value
    Cells(ActiveCell.Row, 2).Value = CDate(Week11.Value)
    Cells(ActiveCell.Row, 3).Value = CDate(Week22.Value)
    Cells(ActiveCell.Row, 4).Value = PGNumber.Value
    Cells(ActiveCell.Row, 5).Value = Machine.Value
    Cells(ActiveCell.Row, 6).Value = TPM.Value
    If Result2.Value = True Then
        Cells(ActiveCell.Row, 7).Value = "REQUIRES ATTENTION"
        Cells(ActiveCell.Row, 8).Value = ""
    End If
    If Result1.Value = True Then
        Cells(ActiveCell.Row, 8).Value = "OK"
        Cells(ActiveCell.Row, 7).Value = ""
        Cells(ActiveCell.Row, 11) = Now
    End If
    Cells(ActiveCell.Row, 9).Value = Comments.Value
    Me.Hide
End Sub

[krishnaa_kumarr88]

ITS NOT WORKING

[Rudi]

How about this? (Air code)

Code: Select all

    Cells(ActiveCell.Row, 2).Value = Format(CDate(Week11.Value),"dd/mm/yy")
    Cells(ActiveCell.Row, 3).Value = Format(CDate(Week22.Value),"dd/mm/yy")

[krishnaa_kumarr88]

Thats not working too :(

[HansV]

Could you tell us:

1) Are the dates displayed correctly on the userform?
2) Do the dates change when you save them to the worksheet by clicking OK on the userform?

[PJ_in_FL]

The cells' format overrides the format applied to the value VBA enters. Apply Long Date format to the cells then run the macro and you'll see dates displayed like:
Thursday, March 02, 1995
Monday, December 05, 2005
when the values for week11 and week22 are forced to:
week11 = CDate("2/3/95")
week22 = CDate("5/12/2005")
So, format the cells the way you want the date displayed, either within the VBA code or when setting up the worksheet.