UserForm frozes on other computers

Jorge24 · Tuesday at 11:59 AM

I created a UserForm that stores 15 fields into a worksheet. This UserForm has functions like opens a ListBox with all the records, filter the records, edit the records, etc. When I run the UserForm everything is fine and it runs smoothly. But I'm having a problem that when my coworkers try to run it, it frozes a lot and it's hard to use. I stored the file in sharepoint so my coworkers can access the file and work on it. One thing I want to add that my version of Excel is 64 bit and my coworkers are using the 32 bit version. I want to know if this is what's causing the issue.

Logit · Tuesday at 1:23 PM

The answer to your question is 'yes'. There are differences between 64 bit and 32 bit ... most likely some portion of your code is causing that error.
You would need to post your entire code or place the workbook on a download website (not confidential data - include link here for download) in order
for someone to assist you.

Jorge24 · Tuesday at 2:50 PM

Logit said:
The answer to your question is 'yes'. There are differences between 64 bit and 32 bit ... most likely some portion of your code is causing that error.
You would need to post your entire code or place the workbook on a download website (not confidential data - include link here for download) in order
for someone to assist you.

This is my full code for my 2 forms

frmEnterData
Public EnableEvents As Boolean

Private Sub cmbArea_Change() 'Event handler for when the area combo box value changes

'Enable the machine combo box only if an area has been selected
If cmbArea.Value <> "" Then
cmbMachine.Enabled = True
LoadMachine cmbArea.Value 'load machines depending on the area

Else
'Disable machine combo box if no area is selected
cmbMachine.Enabled = False
cmbMachine.Value = " "
End If

End Sub

Sub LoadMachine(ByVal area As String) 'Subroutine to load machines based on the selected area

'Clear the machine ComboBox
cmbMachine.Clear

' Define machine arrays for each area
Dim machinesAssy As Variant
machinesAssy = Array("DURL1", "DURL2", "DURL3", "DURL4", "DURL5", "DURL678", "SUBDU", "DCOUR", "DUFAE", "DUPRE", "TPOTA", "WIRE", "A200 OVLR", "AR", "B100", "B200", "BF LATCH", "BF RELAY", "CARTRIDGE", "COLLARS", "DPC", "MS", "J11S", "SOLENOIDE", "VAC 4", "VAC 5-6", "A200 5-6", "L63-L64", "A200 7-8", "KITS 5-8", "54 MM", "76 MM", "ITCOI", "HDL.MECH", "SZ 1&2", "SZ 3&4", "SZ 5&6", "INTERLOCK")

Dim machinesPPW As Variant
machinesPPW = Array("PPW #1", "PPW #2", "PPW #3", "PPW #4", "PPW #5", "PPW #7", "PPW #8", "PPW #9", "PPW #10", "PPW #20", "Multi Tapping", "Maq. Rotativa #1", "Maq. Rotativa #2", "Welding #1", "Welding #2", "Welding #3", "Welding #4", "Welding #5", "Machine #12", "Machine #16", "Machine #17", "Maquina Rouselle", "Cooling Tower", "Waste Water Evaporator")

Dim machinesCoils As Variant
machinesCoils = Array("Potting")

Dim machinesTHS As Variant
machinesTHS = Array("THS #1 (Glasspoly)", "THS #2 (Glasspoly)", "THS #4 (Glasspoly)", "THS #5 (Glasspoly)", "THS #6 (Glasspoly)", "Machine #9 (Injection Molding)", "Machine #10 (Injection Molding)", "Machine #12 (Injection Molding)", "Machine #13 (Injection Molding)", "Machine #22 (Injection Molding)", "Machine #16 (Deflash)", "Machine #17 (Deflash)", "Machine #28 (Deflash)", "Machine #7 (Grid)", "Machine #18", "Machine #20", "Machine #21", "Machine #23", "Machine #24", "Machine #26", "Machine #27", "Machine #31", "Cooling Tower", "Dust Collector")

Dim machinesTHP As Variant
machinesTHP = Array("Machine #1", "Machine #2", "Machine #3", "Machine #4", "Machine #7", "Machine #8", "Machine #9", "Machine #10", "Machine #11", "Machine #13", "Machine #14", "Machine #15", "Machine #16", "Machine #17", "Machine #18", "Machine #19", "Machine #20", "Macine #21", "Machine #22", "Machine #23", "Machine #24(Las Piedras)", "Machine #25(Las Piedras)", "Machine #26(Las Piedras)", "Dust Collector")

Dim machinesMA As Variant
machinesMA = Array("Machine #17", "Machine #19", "Machine #20", "Machine #25", "Machine #26", "Chavalier 1", "Chavalier 2", "Okamoto", "Grinding Chavalier", "Riveting Machine Mag 65mm", "Grinding Chavalier", "Riveting Machine Arm 65mm", "Abplanab", "Riveting Machine 14A", "Riveting Machine 14B", "Abplanab 29", "Riveting Machine 12", "UV", "Riveting Machine 11", "Dennisor 10", "Dennisor 9")

Dim machinesMachineCenter As Variant
machinesMachineCenter = Array("")

Dim machinesToolRoom As Variant
machinesToolRoom = Array("")

Dim machinesMaintenance As Variant
machinesMaintenance = Array("")

' Load machines based on the selected area
Select Case area
Case "Assy"
cmbMachine.List = machinesAssy
Case "PPW"
cmbMachine.List = machinesPPW
Case "Coils"
cmbMachine.List = machinesCoils
Case "THS"
cmbMachine.List = machinesTHS
Case "THP"
cmbMachine.List = machinesTHP
Case "M/A"
cmbMachine.List = machinesMA
Case "Machine Center"
cmbMachine.List = machinesMachineCenter
Case "Tool Room"
cmbMachine.List = machinesToolRoom
Case "Maintenance"
cmbMachine.List = machinesMaintenance
End Select

End Sub

Private Sub cmbPlaceOrder_Change()

'Enable or disable the Po and delivery date text boxes based on the selection of place order
If cmbPlaceOrder.Value = "Yes" Then
txtPO.Enabled = True
txtDeliveryDate.Enabled = True
Else
txtPO.Enabled = False
txtDeliveryDate.Enabled = False
txtDeliveryDate.Value = " "
End If

End Sub

Private Sub ExitButton_Click()

Dim shDatabase As Worksheet
Dim shSearchData As Worksheet
Set shDatabase = ThisWorkbook.Sheets("Database")
Set shSearchData = ThisWorkbook.Sheets("SearchData")

'Protect both worksheets after exiting the form
shDatabase.Protect Password:="Database"
shSearchData.Protect Password:="Searchdata"

'Unload the current form
Unload Me

End Sub

Private Sub OpenRecordsButton_Click()

'Load a ListBox showing all the records
Load frmOpenRecords
UpdateListBox
SearchColumn
frmOpenRecords.Show

End Sub
Sub UpdateListBox()

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Database")
Dim lastRow As Long
lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).row
Dim i As Long

'Configure the ListBox to display the search results
With frmOpenRecords.lstOpenRecords
.Clear
.ColumnCount = 15
.ColumnHeads = True
.ColumnWidths = "60; 80; 60; 100; 180; 100; 100; 250; 250; 65; 65; 80; 105; 100; 50"
.TextAlign = fmTextAlignLeft
.Font.Size = 10
.RowSource = "Database!A2:O" & lastRow
End With

End Sub

Private Sub SubmitButton_Click()

Dim lastRow As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Database")
Dim i As Long

'Validate required fields
If cmbArea.Value = " " Then
MsgBox "Please enter the area.", vbExclamation, "Missing Information"
Exit Sub
End If

If txtEntryDate.Value = " " Then
MsgBox "Please enter the Entry Date.", vbExclamation, "Missing Information"
Exit Sub
End If

If txtResponsible.Value = " " Then
MsgBox "Please enter the name of the responsible person.", vbExclamation, "Missing Information"
Exit Sub
End If

If cmbMachine.Value = " " Then
MsgBox "Please select a Machine.", vbExclamation, "Missing Information"
Exit Sub
End If

'Determine the row to update or add new record
If frmEnterData.txtRowNumber.Value = "" Then
lastRow = [Counta(Database!A:A)] + 1
Else
lastRow = frmEnterData.txtRowNumber.Value
End If

'Update the worksheet with the form data
With ws
ws.Cells(lastRow, "A") = lastRow - 1
ws.Cells(lastRow, "B") = frmEnterData.cmbArea.Value
ws.Cells(lastRow, "C") = frmEnterData.txtEntryDate.Value
ws.Cells(lastRow, "D") = frmEnterData.txtResponsible.Value
ws.Cells(lastRow, "E") = frmEnterData.cmbMachine.Value
ws.Cells(lastRow, "F") = frmEnterData.txtModel.Value
ws.Cells(lastRow, "G") = frmEnterData.txtManufacturer.Value
ws.Cells(lastRow, "H") = frmEnterData.txtCondition.Value
ws.Cells(lastRow, "I") = frmEnterData.txtDiagnostic.Value
ws.Cells(lastRow, "J") = frmEnterData.cmbPlaceOrder.Value
ws.Cells(lastRow, "K") = frmEnterData.txtPO.Value
ws.Cells(lastRow, "L") = frmEnterData.txtDeliveryDate.Value
ws.Cells(lastRow, "M") = frmEnterData.txtExpectedRepair.Value
ws.Cells(lastRow, "N") = frmEnterData.txtActualRepair.Value
End With

'Update Status column based on Actual Repair Date column
For i = 2 To lastRow
If ws.Cells(i, "N").Value = "" Then
ws.Cells(i, "O").Value = "Open"
Else
ws.Cells(i, "O").Value = "Closed"
End If
Next i

MsgBox "Data submitted successfully!"

'Clear form fields after submitting
cmbArea.Value = " "
txtEntryDate.Value = " "
cmbMachine.Value = " "
txtModel.Value = " "
txtManufacturer.Value = " "
txtCondition.Value = " "
txtDiagnostic.Value = " "
txtResponsible.Value = " "
cmbPlaceOrder.Value = " "
txtPO.Value = ""
txtDeliveryDate.Value = " "
txtExpectedRepair.Value = " "
txtActualRepair.Value = " "
txtRowNumber.Value = ""

End Sub

Private Sub txtEntryDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
FormatDate txtEntryDate, Cancel 'Format the entry date when the text box loses focus
End Sub

Private Sub txtDeliveryDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
FormatDate txtDeliveryDate, Cancel 'Format the delivery date when the text box loses focus
End Sub

Private Sub txtExpectedRepair_Exit(ByVal Cancel As MSForms.ReturnBoolean)
FormatDate txtExpectedRepair, Cancel 'Format the expected repair date when the text box loses focus
End Sub

Private Sub txtactualrepair_Exit(ByVal Cancel As MSForms.ReturnBoolean)
FormatDate txtActualRepair, Cancel 'Format the actual repair date when the text box loses focus
End Sub

Sub FormatDate(ByRef txtBox As MSForms.TextBox, ByRef Cancel As MSForms.ReturnBoolean)

'Format the date in the text box to mm/dd/yyyy
Dim d As Date
If IsDate(txtBox.Value) Then
d = CDate(txtBox.Value)
txtBox.Value = Format(d, "mm/dd/yyyy")
Else
'Show error message if date is invalid
MsgBox "Please enter a valid date in the format mm/dd/yyyy.", vbExclamation, "Invalid Date"
Cancel = True

End If

End Sub

Private Sub txtEntryDate_Enter()

'Clear the default date format when the text box gains focus
If txtEntryDate.Value = "mm/dd/yyyy" Then
txtEntryDate.Value = " "
End If
End Sub

Private Sub txtDeliveryDate_Enter()

'Clear the default date format when the text box gains focus
If txtDeliveryDate.Value = "mm/dd/yyyy" Then
txtDeliveryDate.Value = " "
End If
End Sub

Private Sub txtExpectedRepair_Enter()

'Clear the default date format when the text box gains focus
If txtExpectedRepair.Value = "mm/dd/yyyy" Then
txtExpectedRepair.Value = " "
End If
End Sub

Private Sub txtActualRepair_Enter()

'Clear the default date format when the text box gains focus
If txtActualRepair.Value = "mm/dd/yyyy" Then
txtActualRepair.Value = " "
End If
End Sub

Sub SearchColumn()

' Disable events to prevent triggering other event handlers
frmOpenRecords.EnableEvents = False

' Initialize combo boxes
InitializeComboBox frmOpenRecords.cmbColumnFilter, Array("Area"), "Area"
InitializeComboBox frmOpenRecords.cmbStatusFilter, Array("Status"), "Status"
InitializeComboBox frmOpenRecords.cmbStatus, Array("Open", "Closed"), ""
InitializeComboBox frmOpenRecords.cmbAreas, Array("All", "Assy", "PPW", "Coils", "THS", "THP", "M/A", "Machine Center", "Tool Room", "Maintenance"), "All"

' Re-enable events
frmOpenRecords.EnableEvents = True
End Sub

Sub InitializeComboBox(cmb As MSForms.ComboBox, items As Variant, defaultValue As String)
With cmb
.Clear
Dim i As Integer
For i = LBound(items) To UBound(items)
.AddItem items(i)
Next i
.Value = defaultValue
End With
End Sub

Sub UserForm_Initialize()

Dim shDatabase As Worksheet
Dim shSearchData As Worksheet
Set shDatabase = ThisWorkbook.Sheets("Database")
Set shSearchData = ThisWorkbook.Sheets("SearchData")

'Unprotect the worksheets
shDatabase.Unprotect Password:="Database"
shSearchData.Unprotect Password:="Searchdata"

'Call the SearchColumn subroutine to intiialize combo boxes
Call SearchColumn

' Disable autofilter mode and clear the SearchData sheet
With ThisWorkbook.Sheets("Database")
.AutoFilterMode = False
End With
With ThisWorkbook.Sheets("SearchData")
.AutoFilterMode = False
.Cells.Clear
End With

' Initialize the area ComboBox
InitializeComboBox cmbArea, Array("Assy", "PPW", "Coils", "THS", "THP", "M/A", "Machine Center", "Tool Room", "Maintenance"), ""

' Clear the row number TextBox
txtRowNumber.Value = ""

' Initialize the place order ComboBox
InitializeComboBox cmbPlaceOrder, Array("Yes", "No"), ""

' Disable the PO and delivery date text boxes and machine ComboBox
txtPO.Enabled = False
txtDeliveryDate.Enabled = False
cmbMachine.Enabled = False
End Sub

Function Selected_List() As Long

Dim i As Long
Selected_List = 0

'Find the selected item in the ListBox
For i = 0 To frmOpenRecords.lstOpenRecords.ListCount - 1
If frmOpenRecords.lstOpenRecords.Selected(i) = True Then
Selected_List = i + 1
Exit For
End If
Next i

End Function

frmOpenRecords
Public EnableEvents As Boolean 'Public variable to enable or disable events

Private Sub ButtonSearch_Click()

'Check if an area is selected
If Me.cmbAreas = "" Then
MsgBox "Please enter an area.", vbOKOnly + vbInformation, "Search"
Exit Sub
End If

Call SearchData 'Call the search data subroutine

End Sub

Private Sub CancelButton_Click()

Unload Me 'Unload the current form

End Sub

Private Sub cmbColumnFilter_Change()

If Me.EnableEvents = False Then Exit Sub 'Exit the subroutine if events are disbaled

End Sub

Private Sub EditButton_Click()
Dim selectedIndex As Long
selectedIndex = lstOpenRecords.ListIndex

'Cehck if a record is selected
If selectedIndex <> -1 Then
Load frmEnterData 'Load the data entry form

'Populate the form with the selected record's data
With frmEnterData
.txtRowNumber.Value = Application.WorksheetFunction.Match(frmOpenRecords.lstOpenRecords.List(frmOpenRecords.lstOpenRecords.ListIndex, 0), _
ThisWorkbook.Sheets("Database").Range("A:A"), 0)

.cmbArea.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 1)
.txtEntryDate.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 2)
.txtResponsible.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 3)
.cmbMachine.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 4)
.txtModel.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 5)
.txtManufacturer.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 6)
.txtCondition.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 7)
.txtDiagnostic.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 8)
.cmbPlaceOrder.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 9)
.txtPO.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 10)
.txtDeliveryDate.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 11)
.txtExpectedRepair.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 12)
.txtActualRepair.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 13)
End With
Unload Me 'Unload the current form
Else
MsgBox "Please select a record to edit.", vbOKOnly + vbInformation, "Edit" 'Show a message if no record is selected
End If

End Sub
Public Sub LoadRecordForEditing(ByVal row As Long)

Load frmEnterData 'Load the data entry form

'Populate the form with the data from the specified row
With ThisWorkbook.Sheets("Database")
frmEnterData.cmbArea.Value = .Cells(row, "B").Value
frmEnterData.txtEntryDate.Value = .Cells(row, "C").Value
frmEnterData.txtResponsible.Value = .Cells(row, "D").Value
frmEnterData.cmbMachine.Value = .Cells(row, "E").Value
frmEnterData.txtModel.Value = .Cells(row, "F").Value
frmEnterData.txtManufacturer.Value = .Cells(row, "G").Value
frmEnterData.txtCondition.Value = .Cells(row, "H").Value
frmEnterData.txtDiagnostic.Value = .Cells(row, "I").Value
frmEnterData.cmbPlaceOrder.Value = .Cells(row, "J").Value
frmEnterData.txtPO.Value = .Cells(row, "K").Value
frmEnterData.txtDeliveryDate.Value = .Cells(row, "L").Value
frmEnterData.txtExpectedRepair.Value = .Cells(row, "M").Value
frmEnterData.txtActualRepair.Value = .Cells(row, "N").Value
End With

End Sub

Sub SearchData()

Application.ScreenUpdating = False
Dim shDatabase As Worksheet
Dim shSearchData As Worksheet
Dim iColumn As Integer
Dim iDatabaseRow As Long
Dim iSearchRow As Long
Dim sColumn As String
Dim sValue As String
Dim sStatus As String
Dim sStatusValue As String
Dim iStatus As Integer

'Set references to the database and search data sheets
Set shDatabase = ThisWorkbook.Sheets("Database")
Set shSearchData = ThisWorkbook.Sheets("SearchData")

iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).row 'Get the last row with data in the database sheet
sColumn = frmOpenRecords.cmbColumnFilter.Value
sValue = frmOpenRecords.cmbAreas.Value
iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:O1"), 0)
sStatus = frmOpenRecords.cmbStatusFilter.Value
sStatusValue = frmOpenRecords.cmbStatus.Value
iStatus = Application.WorksheetFunction.Match(sStatus, shDatabase.Range("A1:O1"), 0)

'Remove any existing filters
If shDatabase.FilterMode = True Then
shDatabase.AutoFilterMode = False
End If

'Apply filters based on the selected area and status
If sValue = "All" Then
shDatabase.Range("A1:O" & iDatabaseRow).AutoFilter field:=iStatus, Criteria1:=sStatusValue

Else
shDatabase.Range("A1:O" & iDatabaseRow).AutoFilter field:=iColumn, Criteria1:=sValue
shDatabase.Range("A1:O" & iDatabaseRow).AutoFilter field:=iStatus, Criteria1:=sStatusValue
End If

'Check if there are any records found
If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("B:B")) >= 2 Then
shSearchData.Cells.Clear
shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")
Application.CutCopyMode = False
iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).row

'Configure the ListBox to display the search results
With frmOpenRecords
.lstOpenRecords.ColumnCount = 16
.lstOpenRecords.ColumnWidths = "60; 80; 60; 100; 180; 100; 100; 250; 250; 65; 65; 80; 105; 100; 50; 0"
.lstOpenRecords.TextAlign = fmTextAlignLeft
.lstOpenRecords.Font.Size = 10
.lstOpenRecords.ColumnHeads = True

'Set the rowsource for the ListBox if there are results
If iSearchRow > 1 Then
frmOpenRecords.lstOpenRecords.RowSource = "SearchData!A2:P" & iSearchRow
End If
End With
Else
MsgBox "No record Found." 'Show a message if no records are found
End If

'Remove the filter and re-enable screen updating
shDatabase.AutoFilterMode = False
Application.ScreenUpdating = True

End Sub

Jorge24 · Tuesday at 2:56 PM

Logit said:
The answer to your question is 'yes'. There are differences between 64 bit and 32 bit ... most likely some portion of your code is causing that error.
You would need to post your entire code or place the workbook on a download website (not confidential data - include link here for download) in order
for someone to assist you.

This is the full code for my 2 forms

frmEnter Data

VBA Code:

Public EnableEvents As Boolean

Private Sub cmbArea_Change() 'Event handler for when the area combo box value changes
    
    'Enable the machine combo box only if an area has been selected
    If cmbArea.Value <> "" Then
        cmbMachine.Enabled = True
        LoadMachine cmbArea.Value 'load machines depending on the area
        
    Else
        'Disable machine combo box if no area is selected
        cmbMachine.Enabled = False
        cmbMachine.Value = " "
     End If
    
End Sub

Sub LoadMachine(ByVal area As String) 'Subroutine to load machines based on the selected area
    
    'Clear the machine ComboBox
    cmbMachine.Clear
    
    ' Define machine arrays for each area
    Dim machinesAssy As Variant
    machinesAssy = Array("DURL1", "DURL2", "DURL3", "DURL4", "DURL5", "DURL678", "SUBDU", "DCOUR", "DUFAE", "DUPRE", "TPOTA", "WIRE", "A200 OVLR", "AR", "B100", "B200", "BF LATCH", "BF RELAY", "CARTRIDGE", "COLLARS", "DPC", "MS", "J11S", "SOLENOIDE", "VAC 4", "VAC 5-6", "A200 5-6", "L63-L64", "A200 7-8", "KITS 5-8", "54 MM", "76 MM", "ITCOI", "HDL.MECH", "SZ 1&2", "SZ 3&4", "SZ 5&6", "INTERLOCK")
    
    Dim machinesPPW As Variant
    machinesPPW = Array("PPW #1", "PPW #2", "PPW #3", "PPW #4", "PPW #5", "PPW #7", "PPW #8", "PPW #9", "PPW #10", "PPW #20", "Multi Tapping", "Maq. Rotativa #1", "Maq. Rotativa #2", "Welding #1", "Welding #2", "Welding #3", "Welding #4", "Welding #5", "Machine #12", "Machine #16", "Machine #17", "Maquina Rouselle", "Cooling Tower", "Waste Water Evaporator")
    
    Dim machinesCoils As Variant
    machinesCoils = Array("Potting")
    
    Dim machinesTHS As Variant
    machinesTHS = Array("THS #1 (Glasspoly)", "THS #2 (Glasspoly)", "THS #4 (Glasspoly)", "THS #5 (Glasspoly)", "THS #6 (Glasspoly)", "Machine #9 (Injection Molding)", "Machine #10 (Injection Molding)", "Machine #12 (Injection Molding)", "Machine #13 (Injection Molding)", "Machine #22 (Injection Molding)", "Machine #16 (Deflash)", "Machine #17 (Deflash)", "Machine #28 (Deflash)", "Machine #7 (Grid)", "Machine #18", "Machine #20", "Machine #21", "Machine #23", "Machine #24", "Machine #26", "Machine #27", "Machine #31", "Cooling Tower", "Dust Collector")
    
    Dim machinesTHP As Variant
    machinesTHP = Array("Machine #1", "Machine #2", "Machine #3", "Machine #4", "Machine #7", "Machine #8", "Machine #9", "Machine #10", "Machine #11", "Machine #13", "Machine #14", "Machine #15", "Machine #16", "Machine #17", "Machine #18", "Machine #19", "Machine #20", "Macine #21", "Machine #22", "Machine #23", "Machine #24(Las Piedras)", "Machine #25(Las Piedras)", "Machine #26(Las Piedras)", "Dust Collector")
    
    Dim machinesMA As Variant
    machinesMA = Array("Machine #17", "Machine #19", "Machine #20", "Machine #25", "Machine #26", "Chavalier 1", "Chavalier 2", "Okamoto", "Grinding Chavalier", "Riveting Machine Mag 65mm", "Grinding Chavalier", "Riveting Machine Arm 65mm", "Abplanab", "Riveting Machine 14A", "Riveting Machine 14B", "Abplanab 29", "Riveting Machine 12", "UV", "Riveting Machine 11", "Dennisor 10", "Dennisor 9")
    
    Dim machinesMachineCenter As Variant
    machinesMachineCenter = Array("")
    
    Dim machinesToolRoom As Variant
    machinesToolRoom = Array("")
    
    Dim machinesMaintenance As Variant
    machinesMaintenance = Array("")
    
    ' Load machines based on the selected area
    Select Case area
        Case "Assy"
            cmbMachine.List = machinesAssy
        Case "PPW"
            cmbMachine.List = machinesPPW
        Case "Coils"
            cmbMachine.List = machinesCoils
        Case "THS"
            cmbMachine.List = machinesTHS
        Case "THP"
            cmbMachine.List = machinesTHP
        Case "M/A"
            cmbMachine.List = machinesMA
        Case "Machine Center"
            cmbMachine.List = machinesMachineCenter
        Case "Tool Room"
            cmbMachine.List = machinesToolRoom
        Case "Maintenance"
            cmbMachine.List = machinesMaintenance
    End Select
    
End Sub

Private Sub cmbPlaceOrder_Change()
    
    'Enable or disable the Po and delivery date text boxes based on the selection of place order
    If cmbPlaceOrder.Value = "Yes" Then
        txtPO.Enabled = True
        txtDeliveryDate.Enabled = True
    Else
        txtPO.Enabled = False
        txtDeliveryDate.Enabled = False
        txtDeliveryDate.Value = " "
    End If
      
End Sub

Private Sub ExitButton_Click()
    
    Dim shDatabase As Worksheet
    Dim shSearchData As Worksheet
    Set shDatabase = ThisWorkbook.Sheets("Database")
    Set shSearchData = ThisWorkbook.Sheets("SearchData")
    
    'Protect both worksheets after exiting the form
    shDatabase.Protect Password:="Database"
    shSearchData.Protect Password:="Searchdata"
    
    'Unload the current form
    Unload Me
    
End Sub

Private Sub OpenRecordsButton_Click()
                  
    'Load a ListBox showing all the records
    Load frmOpenRecords
    UpdateListBox
    SearchColumn
    frmOpenRecords.Show
    
End Sub
Sub UpdateListBox()
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Database")
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "O").End(xlUp).row
    Dim i As Long
    
    'Configure the ListBox to display the search results
    With frmOpenRecords.lstOpenRecords
        .Clear
        .ColumnCount = 15
        .ColumnHeads = True
        .ColumnWidths = "60; 80; 60; 100; 180; 100; 100; 250; 250; 65; 65; 80; 105; 100; 50"
        .TextAlign = fmTextAlignLeft
        .Font.Size = 10
        .RowSource = "Database!A2:O" & lastRow
    End With
  
End Sub

Private Sub SubmitButton_Click()
    
    Dim lastRow As Long
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Database")
    Dim i As Long
    
    'Validate required fields
    If cmbArea.Value = " " Then
        MsgBox "Please enter the area.", vbExclamation, "Missing Information"
        Exit Sub
    End If
    
    If txtEntryDate.Value = " " Then
        MsgBox "Please enter the Entry Date.", vbExclamation, "Missing Information"
        Exit Sub
    End If
    
    If txtResponsible.Value = " " Then
        MsgBox "Please enter the name of the responsible person.", vbExclamation, "Missing Information"
        Exit Sub
    End If
    
    If cmbMachine.Value = " " Then
        MsgBox "Please select a Machine.", vbExclamation, "Missing Information"
        Exit Sub
    End If
                
    'Determine the row to update or add new record
    If frmEnterData.txtRowNumber.Value = "" Then
        lastRow = [Counta(Database!A:A)] + 1
    Else
        lastRow = frmEnterData.txtRowNumber.Value
    End If
    
 
    'Update the worksheet with the form data
    With ws
        ws.Cells(lastRow, "A") = lastRow - 1
        ws.Cells(lastRow, "B") = frmEnterData.cmbArea.Value
        ws.Cells(lastRow, "C") = frmEnterData.txtEntryDate.Value
        ws.Cells(lastRow, "D") = frmEnterData.txtResponsible.Value
        ws.Cells(lastRow, "E") = frmEnterData.cmbMachine.Value
        ws.Cells(lastRow, "F") = frmEnterData.txtModel.Value
        ws.Cells(lastRow, "G") = frmEnterData.txtManufacturer.Value
        ws.Cells(lastRow, "H") = frmEnterData.txtCondition.Value
        ws.Cells(lastRow, "I") = frmEnterData.txtDiagnostic.Value
        ws.Cells(lastRow, "J") = frmEnterData.cmbPlaceOrder.Value
        ws.Cells(lastRow, "K") = frmEnterData.txtPO.Value
        ws.Cells(lastRow, "L") = frmEnterData.txtDeliveryDate.Value
        ws.Cells(lastRow, "M") = frmEnterData.txtExpectedRepair.Value
        ws.Cells(lastRow, "N") = frmEnterData.txtActualRepair.Value
    End With
    
    'Update Status column based on Actual Repair Date column
    For i = 2 To lastRow
        If ws.Cells(i, "N").Value = "" Then
            ws.Cells(i, "O").Value = "Open"
        Else
            ws.Cells(i, "O").Value = "Closed"
        End If
    Next i
    
    MsgBox "Data submitted successfully!"
    
    'Clear form fields after submitting
    cmbArea.Value = " "
    txtEntryDate.Value = " "
    cmbMachine.Value = " "
    txtModel.Value = " "
    txtManufacturer.Value = " "
    txtCondition.Value = " "
    txtDiagnostic.Value = " "
    txtResponsible.Value = " "
    cmbPlaceOrder.Value = " "
    txtPO.Value = ""
    txtDeliveryDate.Value = " "
    txtExpectedRepair.Value = " "
    txtActualRepair.Value = " "
    txtRowNumber.Value = ""
    
End Sub


Private Sub txtEntryDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    FormatDate txtEntryDate, Cancel 'Format the entry date when the text box loses focus
End Sub

Private Sub txtDeliveryDate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    FormatDate txtDeliveryDate, Cancel 'Format the delivery date when the text box loses focus
End Sub

Private Sub txtExpectedRepair_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    FormatDate txtExpectedRepair, Cancel 'Format the expected repair date when the text box loses focus
End Sub

Private Sub txtactualrepair_Exit(ByVal Cancel As MSForms.ReturnBoolean)
    FormatDate txtActualRepair, Cancel 'Format the actual repair date when the text box loses focus
End Sub

Sub FormatDate(ByRef txtBox As MSForms.TextBox, ByRef Cancel As MSForms.ReturnBoolean)
    
    'Format the date in the text box to mm/dd/yyyy
    Dim d As Date
    If IsDate(txtBox.Value) Then
        d = CDate(txtBox.Value)
        txtBox.Value = Format(d, "mm/dd/yyyy")
    Else
        'Show error message if date is invalid
        MsgBox "Please enter a valid date in the format mm/dd/yyyy.", vbExclamation, "Invalid Date"
        Cancel = True
        
    End If
    
End Sub

Private Sub txtEntryDate_Enter()
    
    'Clear the default date format when the text box gains focus
    If txtEntryDate.Value = "mm/dd/yyyy" Then
        txtEntryDate.Value = " "
    End If
End Sub

Private Sub txtDeliveryDate_Enter()
    
    'Clear the default date format when the text box gains focus
    If txtDeliveryDate.Value = "mm/dd/yyyy" Then
        txtDeliveryDate.Value = " "
    End If
End Sub

Private Sub txtExpectedRepair_Enter()
    
    'Clear the default date format when the text box gains focus
    If txtExpectedRepair.Value = "mm/dd/yyyy" Then
        txtExpectedRepair.Value = " "
    End If
End Sub

Private Sub txtActualRepair_Enter()
    
    'Clear the default date format when the text box gains focus
    If txtActualRepair.Value = "mm/dd/yyyy" Then
        txtActualRepair.Value = " "
    End If
End Sub

Sub SearchColumn()
    
  ' Disable events to prevent triggering other event handlers
    frmOpenRecords.EnableEvents = False
    
    ' Initialize combo boxes
    InitializeComboBox frmOpenRecords.cmbColumnFilter, Array("Area"), "Area"
    InitializeComboBox frmOpenRecords.cmbStatusFilter, Array("Status"), "Status"
    InitializeComboBox frmOpenRecords.cmbStatus, Array("Open", "Closed"), ""
    InitializeComboBox frmOpenRecords.cmbAreas, Array("All", "Assy", "PPW", "Coils", "THS", "THP", "M/A", "Machine Center", "Tool Room", "Maintenance"), "All"
    
    ' Re-enable events
    frmOpenRecords.EnableEvents = True
End Sub

Sub InitializeComboBox(cmb As MSForms.ComboBox, items As Variant, defaultValue As String)
    With cmb
        .Clear
        Dim i As Integer
        For i = LBound(items) To UBound(items)
            .AddItem items(i)
        Next i
        .Value = defaultValue
    End With
End Sub

Sub UserForm_Initialize()
    
   Dim shDatabase As Worksheet
   Dim shSearchData As Worksheet
   Set shDatabase = ThisWorkbook.Sheets("Database")
   Set shSearchData = ThisWorkbook.Sheets("SearchData")
  
   'Unprotect the worksheets
   shDatabase.Unprotect Password:="Database"
   shSearchData.Unprotect Password:="Searchdata"
  
   'Call the SearchColumn subroutine to intiialize combo boxes
   Call SearchColumn
  
   ' Disable autofilter mode and clear the SearchData sheet
    With ThisWorkbook.Sheets("Database")
        .AutoFilterMode = False
    End With
    With ThisWorkbook.Sheets("SearchData")
        .AutoFilterMode = False
        .Cells.Clear
    End With
    
    ' Initialize the area ComboBox
    InitializeComboBox cmbArea, Array("Assy", "PPW", "Coils", "THS", "THP", "M/A", "Machine Center", "Tool Room", "Maintenance"), ""
    
    ' Clear the row number TextBox
    txtRowNumber.Value = ""
    
    ' Initialize the place order ComboBox
    InitializeComboBox cmbPlaceOrder, Array("Yes", "No"), ""
    
    ' Disable the PO and delivery date text boxes and machine ComboBox
    txtPO.Enabled = False
    txtDeliveryDate.Enabled = False
    cmbMachine.Enabled = False
End Sub

Function Selected_List() As Long
    
    Dim i As Long
    Selected_List = 0
    
    'Find the selected item in the ListBox
    For i = 0 To frmOpenRecords.lstOpenRecords.ListCount - 1
        If frmOpenRecords.lstOpenRecords.Selected(i) = True Then
            Selected_List = i + 1
            Exit For
        End If
    Next i
    
End Function

frmOpenRecords

VBA Code:

Public EnableEvents As Boolean 'Public variable to enable or disable events

Private Sub ButtonSearch_Click()
    
    'Check if an area is selected
    If Me.cmbAreas = "" Then
        MsgBox "Please enter an area.", vbOKOnly + vbInformation, "Search"
        Exit Sub
    End If
    
    Call SearchData 'Call the search data subroutine
    
End Sub

Private Sub CancelButton_Click()
    
    Unload Me 'Unload the current form
    
End Sub

Private Sub cmbColumnFilter_Change()
    
    If Me.EnableEvents = False Then Exit Sub 'Exit the subroutine if events are disbaled
        
End Sub

Private Sub EditButton_Click()
    Dim selectedIndex As Long
    selectedIndex = lstOpenRecords.ListIndex
    
    'Cehck if a record is selected
    If selectedIndex <> -1 Then
        Load frmEnterData 'Load the data entry form
        
        'Populate the form with the selected record's data
        With frmEnterData
            .txtRowNumber.Value = Application.WorksheetFunction.Match(frmOpenRecords.lstOpenRecords.List(frmOpenRecords.lstOpenRecords.ListIndex, 0), _
            ThisWorkbook.Sheets("Database").Range("A:A"), 0)
    
            .cmbArea.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 1)
            .txtEntryDate.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 2)
            .txtResponsible.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 3)
            .cmbMachine.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 4)
            .txtModel.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 5)
            .txtManufacturer.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 6)
            .txtCondition.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 7)
            .txtDiagnostic.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 8)
            .cmbPlaceOrder.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 9)
            .txtPO.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 10)
            .txtDeliveryDate.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 11)
            .txtExpectedRepair.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 12)
            .txtActualRepair.Value = Me.lstOpenRecords.List(Me.lstOpenRecords.ListIndex, 13)
        End With
        Unload Me 'Unload the current form
    Else
        MsgBox "Please select a record to edit.", vbOKOnly + vbInformation, "Edit" 'Show a message if no record is selected
    End If
  
End Sub
Public Sub LoadRecordForEditing(ByVal row As Long)
    
    Load frmEnterData 'Load the data entry form
    
    'Populate the form with the data from the specified row
    With ThisWorkbook.Sheets("Database")
        frmEnterData.cmbArea.Value = .Cells(row, "B").Value
        frmEnterData.txtEntryDate.Value = .Cells(row, "C").Value
        frmEnterData.txtResponsible.Value = .Cells(row, "D").Value
        frmEnterData.cmbMachine.Value = .Cells(row, "E").Value
        frmEnterData.txtModel.Value = .Cells(row, "F").Value
        frmEnterData.txtManufacturer.Value = .Cells(row, "G").Value
        frmEnterData.txtCondition.Value = .Cells(row, "H").Value
        frmEnterData.txtDiagnostic.Value = .Cells(row, "I").Value
        frmEnterData.cmbPlaceOrder.Value = .Cells(row, "J").Value
        frmEnterData.txtPO.Value = .Cells(row, "K").Value
        frmEnterData.txtDeliveryDate.Value = .Cells(row, "L").Value
        frmEnterData.txtExpectedRepair.Value = .Cells(row, "M").Value
        frmEnterData.txtActualRepair.Value = .Cells(row, "N").Value
    End With
    
End Sub

Sub SearchData()
    
    Application.ScreenUpdating = False
    Dim shDatabase As Worksheet
    Dim shSearchData As Worksheet
    Dim iColumn As Integer
    Dim iDatabaseRow As Long
    Dim iSearchRow As Long
    Dim sColumn As String
    Dim sValue As String
    Dim sStatus As String
    Dim sStatusValue As String
    Dim iStatus As Integer
    
    'Set references to the database and search data sheets
    Set shDatabase = ThisWorkbook.Sheets("Database")
    Set shSearchData = ThisWorkbook.Sheets("SearchData")
    
    iDatabaseRow = ThisWorkbook.Sheets("Database").Range("A" & Application.Rows.Count).End(xlUp).row 'Get the last row with data in the database sheet
    sColumn = frmOpenRecords.cmbColumnFilter.Value
    sValue = frmOpenRecords.cmbAreas.Value
    iColumn = Application.WorksheetFunction.Match(sColumn, shDatabase.Range("A1:O1"), 0)
    sStatus = frmOpenRecords.cmbStatusFilter.Value
    sStatusValue = frmOpenRecords.cmbStatus.Value
    iStatus = Application.WorksheetFunction.Match(sStatus, shDatabase.Range("A1:O1"), 0)
    
    'Remove any existing filters
    If shDatabase.FilterMode = True Then
        shDatabase.AutoFilterMode = False
    End If
    
    'Apply filters based on the selected area and status
    If sValue = "All" Then
        shDatabase.Range("A1:O" & iDatabaseRow).AutoFilter field:=iStatus, Criteria1:=sStatusValue
    
    Else
        shDatabase.Range("A1:O" & iDatabaseRow).AutoFilter field:=iColumn, Criteria1:=sValue
        shDatabase.Range("A1:O" & iDatabaseRow).AutoFilter field:=iStatus, Criteria1:=sStatusValue
    End If

    'Check if there are any records found
    If Application.WorksheetFunction.Subtotal(3, shDatabase.Range("B:B")) >= 2 Then
        shSearchData.Cells.Clear
        shDatabase.AutoFilter.Range.Copy shSearchData.Range("A1")
        Application.CutCopyMode = False
        iSearchRow = shSearchData.Range("A" & Application.Rows.Count).End(xlUp).row
        
        'Configure the ListBox to display the search results
        With frmOpenRecords
            .lstOpenRecords.ColumnCount = 16
            .lstOpenRecords.ColumnWidths = "60; 80; 60; 100; 180; 100; 100; 250; 250; 65; 65; 80; 105; 100; 50; 0"
            .lstOpenRecords.TextAlign = fmTextAlignLeft
            .lstOpenRecords.Font.Size = 10
            .lstOpenRecords.ColumnHeads = True
        
            'Set the rowsource for the ListBox if there are results
            If iSearchRow > 1 Then
                frmOpenRecords.lstOpenRecords.RowSource = "SearchData!A2:P" & iSearchRow
            End If
        End With
    Else
        MsgBox "No record Found." 'Show a message if no records are found
    End If
    
    'Remove the filter and re-enable screen updating
    shDatabase.AutoFilterMode = False
    Application.ScreenUpdating = True
    
End Sub

Logit · Tuesday at 6:23 PM

I don't see anything in your code that 'screams' This Is A Problem. Someone else may review your code and see something different.

Have you thought of going to one of the computers where the issue occurs and step through all of your code using F8 key ?
You can also go into the VBE editor window ... select DEBUG in the top menu then select COMPILE VBAPROJECT.

Perhaps either or both of the above two actions might locate an issue for you on the 32 bit computer.

UserForm frozes on other computers

Jorge24

New Member

Excel Facts

Logit

Well-known Member

Jorge24

New Member

Jorge24

New Member

Logit

Well-known Member

Similar threads

Forum statistics

Share this page

UserForm frozes on other computers

Jorge24

New Member

Excel Facts

Logit

Well-known Member

Jorge24

New Member

Jorge24

New Member

Logit

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock