UserForm code works, but takes (way) too long.

[johnw911]

I suspect I've put something in the wrong sequence in the code of this UserForm (see code below).

A brief explanation of the purpose:
This UserForm is used to build another 'custom' UserForm by adding data to a worksheet ("ONE"). Another worksheet then 'reads' the data from "ONE" and sorts and places this data (using INDEX, MATCH, ROW, etc.) into the appropriate columns (there are 100 columns). That data is then used by another UserForm to populate it's Comboboxes and Labels. These other UserForms work just fine.

But this UserForm, even though it does exactly what it is supposed to do, appears to get stuck in some kind of loop. It should take less than one second (the cmdOK-Click event), but now takes up to a minute. What am I doing wrong?

Any suggestion or insight is greatly appreciated.

Thank you,

John

Private Sub UserForm_Initialize()   With Worksheets("ADMIN")
    cboDept1.List = .Range("F4", .Range("F" & Rows.Count).End(xlUp)).Value
    End With
    
   With Worksheets("Employees")
    cboName1.List = .Range("A2", .Range("A" & Rows.Count).End(xlUp)).Value
   End With
    
End Sub
Private Sub cboDept1_Change()
Dim idx As Long
Dim I As Long


    idx = cboDept1.ListIndex


    If idx <> -1 Then
        With Sheet2
            For I = 3 To 27
                Me.Controls("Label" & I + 12).Caption = .Range("A" & I).Offset(0, idx).Text
            Next I
        End With
    End If
    
End Sub
Private Sub cmdOK_Click()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim rng As Range
   Set rng = ActiveWorkbook.Sheets("ONE").Range("A" & Rows.Count).End(xlUp).Offset(1)
    For I = 1 To 25
         If Me.Controls("CheckBox" & I).Value = True Then
          rng.Value = cboName1.Value
          rng.Offset(0, 1).Value = cboDept1.Value
          rng.Offset(0, 2).Value = Me.Controls("Label" & I + 14).Caption
          Set rng = rng.Offset(1)
         End If
    Next I
    SortOne
    Unload Me
    UserForm6.Show
Application.ScreenUpdating = True
Application.EnableEvents = True


End Sub
Sub SortOne()
Application.ScreenUpdating = False
Sheets("ONE").Activate
With Worksheets("ONE")
    Range("MYONE").Resize(Range("MYONE").Rows.Count + 1).Name = "MYONE"
    Range("MYONE").Select
        With ActiveWorkbook.ActiveSheet
        .Sort.SortFields.Clear
        .Sort.SortFields.Add _
            Key:=[A1], _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortNormal
        With .Sort
            .SetRange Selection
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
    End With
End With
Application.ScreenUpdating = True
End Sub
Private Sub cmdcancel_Click()
    Unload Me
End Sub

 

[sijpie]

It should be easy to check wich part is causing issues:

in the cmdOK_click sub comment out the three lines

'    SortOne
'    Unload Me
'    UserForm6.Show

If this is still very slow, thenn you need to optimise your code to write the values to the sheet (which I think is the issue)

This part of the code is a loop to write for each of 25 lines three values which is a 75 times write operation. And after each write the workbook recalcs.

So you could set calculation to manual

Application.Calculation = xlManual

or even better write all the results to an array and then write the array to the sheet in one write operation, no need to set the calculation to manual then.

    dim vArr as variant
    redim vArr(1 to 25,1 to 3)
    For I = 1 To 25
         If Me.Controls("CheckBox" & I).Value = True Then
            varr(i,1) = cboName1.Value
            varr(i,2) = cboDept1.Value
            varr(i,3) = Me.Controls("Label" & I + 14).Caption
          
         End If
    Next I
    rng.resize(25,3).value=vArr

 

[johnw911]

Thanks Sijpie! Using your array method works great!
My next challenge is to have the same userform populate with previously entered data based on a Name and Date selected.