Array formula in worksheet causing Userform to virtually stop .. Any suggestions to speed it up?

D

Dobbo222

New Member
Joined
May 22, 2017
Messages
12
I have a Userform which collects data and posts it to a spreadsheet "SURVEYS. Another sheet collects date from this sheet based on a Survey reference and pulls data from each line with the unique survey ref into a sheet called quote.

the array formula is as follows
Code: 
{=IF(ISERROR(INDEX(SURVEYS!$B$2:$W$49999,SMALL(IF(SURVEYS!$B$2:$W$49999=$C$3,ROW(SURVEYS!$B$2:$W$49999)),ROW(1:1)),12)),"",INDEX(SURVEYS!$B$2:$W$49999,SMALL(IF(SURVEYS!$B$2:$W$49999=$C$3,ROW(SURVEYS!$B$2:$W$49999)),ROW(1:1)),12))}
The userform works perfectly if I separate the sheets into 2 workbooks but if they are all part of one workbook the userform takes an age to process writing the data to the survey sheet. I presume the array formula is trying to calculate at the same time the data is being pulled which is causing the issue. Can I call the array rather than have it actual in the cells of the sheet? Would that solve the conflict or is there a better way of doing this. FYI the survey ref can generate more than one return

here is the code for the Userform.

Code: 
Dim Md As BooleanDim lbl() As New Class1










Private Sub CommandButton10_Click()
MsgBox "Are you sure You want to Change Client", vbYesNo
If vbYes Then
MultiPage1.Value = 0


Else
End If


End Sub


Private Sub UserForm1_Initialize()
   


MultiPage1.Value = 0


refresh
TextBox1.SetFocus
TextBox1.Value = UCASE(TextBox1.Value)
TextBox11.Value = UCASE(TextBox11.Value)
TextBox12.Value = UCASE(TextBox12.Value)
TextBox13.Value = UCASE(TextBox13.Value)
TextBox14.Value = UCASE(TextBox14.Value)
TextBox15.Value = UCASE(TextBox15.Value)
TextBox16.Value = UCASE(TextBox16.Value)
TextBox17.Value = UCASE(TextBox17.Value)
TextBox18.Value = UCASE(TextBox18.Value)
TextBox19.Value = UCASE(TextBox19.Value)










End Sub




     






Private Sub CommandButton1_Click()
    
   MultiPage1.Value = 1
   TextBox21.Value = Now
    TextBox21 = Format(TextBox21.Value, "dd mmmm yyyy hh:mm")
    
    
End Sub


Private Sub CommandButton2_Click()


Unload UserForm1


End Sub


Private Sub CommandButton4_Click()
Dim FD, sds As Long


If Me.TextBox1.Value = "" _
Or Me.TextBox2.Value = "" _
Or Me.TextBox3.Value = "" Then


Call MsgBox("The fields are not complete", vbInformation, "Edit Contact")
Exit Sub
End If
                        FD = Sheets("Data").Range("A65536").End(xlUp).Row
                
                        sds = FD + 1
                
                        Sheets("Data").Range("A" & sds).Value = _
                                             Application.WorksheetFunction.Max(Sheets("Data").Range("A:A")) + 1
                
                        Sheets("Data").Range("B" & sds).Value = UCASE(TextBox1.Text)
                
                        Sheets("Data").Range("C" & sds).Value = UCASE(TextBox2.Text)
                
                        Sheets("Data").Range("D" & sds).Value = UCASE(TextBox3.Text)
                        
                        Sheets("Data").Range("E" & sds).Value = UCASE(TextBox14.Value)
                        
                        Sheets("Data").Range("F" & sds).Value = UCASE(TextBox5.Text)
                        
                        Sheets("Data").Range("G" & sds).Value = UCASE(TextBox7.Text)
                        
                        Sheets("Data").Range("H" & sds).Value = UCASE(TextBox8.Text)
                        
                        Sheets("Data").Range("I" & sds).Value = UCASE(TextBox9.Text)
                        
                        Sheets("Data").Range("J" & sds).Value = UCASE(TextBox11.Text)
                        
                        Sheets("Data").Range("K" & sds).Value = UCASE(TextBox12.Text)
                        
                        Sheets("Data").Range("L" & sds).Value = UCASE(TextBox22.Text)
                        
                                
                
                ListBox1.Clear
            refresh
          
End Sub


Private Sub CommandButton8_Click()
Dim del As Control
For Each del In UserForm1.Controls
If TypeName(del) = "TextBox" Or TypeName(del) = "ComboBox" Then
del.Text = Empty
End If
Next del
ListBox1.Value = ""
TextBox28.Value = 1
End Sub


Private Sub OrderEntry_Click()


Dim RowCount As Long








    
    If Me.TextBox19.Value = "" Then
    MsgBox "Please Enter Make of Fridge", vbExclamation, "Survey Form"
    Me.TextBox19.SetFocus
    Exit Sub
    End If
    
     If Me.TextBox13.Value = "" Then
    MsgBox "Please Enter Model Number", vbExclamation, "Survey Form"
    Me.TextBox13.SetFocus
    Exit Sub
    End If
    
    If Me.TextBox18.Value = "" Then
    MsgBox "Please Enter Height", vbExclamation, "Survey Form"
    Me.TextBox18.SetFocus
    Exit Sub
    End If
    
    If Not IsNumeric(Me.TextBox18.Value) Then
    MsgBox "The Height box must contain a number.", vbExclamation, "Survey Form"
    Me.TextBox18.SetFocus
    Exit Sub
    End If
    
    
     If Me.TextBox17.Value = "" Then
    MsgBox "Please Enter Width", vbExclamation, "Survey Form"
    Me.TextBox17.SetFocus
    Exit Sub
    End If
    
    If Not IsNumeric(Me.TextBox17.Value) Then
    MsgBox "The Width box must contain a number.", vbExclamation, "Survey Form"
    Me.TextBox17.SetFocus
    Exit Sub
    End If
    
      If Me.TextBox23.Value = "" Then
    MsgBox "Please Enter Next Order Ref", vbExclamation, "Survey Form"
    Me.TextBox23.SetFocus
    Exit Sub
    End If
    
    If Me.ComboBox7.Value = "" Then
    MsgBox "Please Enter Dart", vbExclamation, "Survey Form"
    Me.ComboBox7.SetFocus
    Exit Sub
    End If
    
    If Me.ComboBox2.Value = "" Then
    MsgBox "Please Enter Profile", vbExclamation, "Survey Form"
    Me.ComboBox2.SetFocus
    Exit Sub
    End If
    
     If Me.ComboBox1.Value = "" Then
    MsgBox "Please Enter Number of Fridges to Survey", vbExclamation, "Survey Form"
    Me.ComboBox1.SetFocus
    Exit Sub
    End If
    
    If Me.ComboBox3.Value = "" Then
    MsgBox "Please Enter Condition", vbExclamation, "Survey Form"
    Me.ComboBox3.SetFocus
    Exit Sub
    End If
    
    If Me.ComboBox4.Value = "" Then
    MsgBox "Please Enter Recommendation", vbExclamation, "Survey Form"
    Me.ComboBox4.SetFocus
    Exit Sub
    End If
    
    If Me.ComboBox5.Value = "" Then
    MsgBox "Please Enter Revisit", vbExclamation, "Survey Form"
    Me.ComboBox5.SetFocus
    Exit Sub
    End If
    
   If Me.TextBox16.Value = "" Then
    MsgBox "Please Enter Asset Tag Number", vbExclamation, "Survey Form"
    Me.TextBox16.SetFocus
    Exit Sub
    End If
    
    Checker
    
    End Sub
    
    
    Sub Submit()
    
    Dim iRow As Long
    Dim ws As Worksheet
    Set ws = Worksheets("SURVEYS")
     
     
     'find first empty row in database
    iRow = ws.Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row + 1
     
     
     
         
         'copy the data to the database
         'use protect and unprotect lines,
         '     with your password
         '     if worksheet is protected
        With ws
             .Unprotect Password:="les"
            .Cells(iRow, 1).Value = Me.TextBox21.Value
            .Cells(iRow, 2).Value = Me.TextBox15.Value
            .Cells(iRow, 3).Value = Me.TextBox14.Value
            .Cells(iRow, 4).Value = Me.TextBox5.Value
            .Cells(iRow, 5).Value = Me.TextBox7.Value
            .Cells(iRow, 6).Value = Me.TextBox8.Value
            .Cells(iRow, 7).Value = Me.TextBox9.Value
            .Cells(iRow, 8).Value = Me.TextBox11.Value
            .Cells(iRow, 9).Value = Me.TextBox12.Value
            .Cells(iRow, 10).Value = Me.TextBox23.Value
            .Cells(iRow, 11).Value = Me.TextBox22.Value
            .Cells(iRow, 12).Value = Me.TextBox21.Value
            .Cells(iRow, 13).Value = Me.TextBox19.Value
            .Cells(iRow, 14).Value = Me.TextBox13.Value
            .Cells(iRow, 15).Value = Me.TextBox18.Value
            .Cells(iRow, 16).Value = Me.TextBox17.Value
            .Cells(iRow, 17).Value = Me.ComboBox7.Value
            .Cells(iRow, 18).Value = Me.ComboBox2.Value
            .Cells(iRow, 19).Value = Me.ComboBox3.Value
            .Cells(iRow, 20).Value = Me.ComboBox4.Value
            .Cells(iRow, 21).Value = Me.ComboBox5.Value
            .Cells(iRow, 22).Value = Me.TextBox16.Value
               .Protect Password:="les"
End With


End Sub


Sub Checker()


Dim Resp2 As Integer
Dim myVal As Double


myVal = TextBox28.Value
myVal = myVal + 1


Resp2 = MsgBox("Are details correct?", 36, "Please confirm")
If Resp2 = 6 Then




Submit


Check2
TextBox28.Value = myVal
Check3


Else
'No was pressed, here's message tellingthem action is cancelled.


End If


End Sub
Sub Check2()
Dim ctl As Control
If TextBox28.Value > ComboBox1.Value Then


MessageBoxMania
Else




For Each ctl In Me.Frame1.Controls
If TypeName(ctl) = "TextBox" Or TypeName(ctl) = "ComboBox" Then
ctl.Value = ""
ElseIf TypeName(ctl) = "CheckBox" Then
ctl.Value = False


End If
    Next ctl
End If
End Sub
Sub Check3()
Dim ctl As Control
If TextBox28.Value > ComboBox1.Value Then


MessageBoxMania
Else




End If
End Sub
Sub MessageBoxMania()
Dim ctl As Control
Dim Resp As Integer


Resp = MsgBox("END OF SURVEY", 36, "Please confirm")


  If Resp = 6 Then
   
    
    
'Yes was pressed, your macro goes here
Unload UserForm1


Else
'No was pressed, here's message tellingthem action is cancelled.
Checker
End If


End Sub
























Private Sub UserForm_Initialize()
Dim FD, sds As Long
       




ListBox1.ColumnCount = 1
MultiPage1.Value = 0


   


      


 


sds = Sheets("Data").[a65536].End(xlUp).Row
ListBox1.List = Sheets("Data").Range("D2:D5000" & sds).Value




End Sub
 


Private Sub CommandButton9_Click()
Dim FD As Long
Dim sor As String


If TextBox1 = "" Or TextBox2 = "" Then
Call MsgBox("click the contact so it can be updated", vbInformation, "Edit Contact")
Exit Sub
End If


sor = MsgBox("Are your sure?", vbYesNo)
If sor = vbNo Then Exit Sub


 FD = ListBox1.ListIndex + 2
                        
                        Sheets("Data").Range("B" & FD).Value = TextBox1.Text
                
                        Sheets("Data").Range("C" & FD).Value = TextBox2.Text
                
                        Sheets("Data").Range("D" & FD).Value = TextBox3.Text
                        Sheets("Data").Range("E" & FD).Value = TextBox14.Text
                        
                        
                        Sheets("Data").Range("F" & FD).Value = TextBox5.Text
                        
                        
                        
                        Sheets("Data").Range("G" & FD).Value = TextBox7.Text
                        
                        Sheets("Data").Range("H" & FD).Value = TextBox8.Text
                        
                        Sheets("Data").Range("I" & FD).Value = TextBox9.Text
                        
                        
                        
                        Sheets("Data").Range("J" & FD).Value = TextBox11.Text
                        Sheets("Data").Range("K" & FD).Value = TextBox12.Text
                        Sheets("Data").Range("L" & FD).Value = TextBox22.Text
                        Sheets("Data").Range("L" & FD).HorizontalAlignment = xlRight


                        Sheets("Data").Select
Call MsgBox("The contact has been updated", vbInformation, "Edit Contact")
refresh
End Sub






Private Sub TextBox3_Change()


TextBox15.Value = TextBox3.Text




TextBox7.Value = TextBox27.Text


















End Sub




    




Private Sub ListBox1_Click()
Dim BsNo As Long
    
    BsNo = ListBox1.ListIndex + 2
    
    TextBox1.Text = Sheets("Data").Range("B" & BsNo).Value
    
    TextBox2.Text = Sheets("Data").Range("C" & BsNo).Value
    
    TextBox3.Text = Sheets("Data").Range("D" & BsNo).Value
    
   TextBox14.Text = Sheets("Data").Range("E" & BsNo).Value
    
    TextBox5.Text = Sheets("Data").Range("F" & BsNo).Value
    
    
    
    TextBox7.Text = Sheets("Data").Range("G" & BsNo).Value
    
    TextBox8.Text = Sheets("Data").Range("H" & BsNo).Value
    
    TextBox9.Text = Sheets("Data").Range("I" & BsNo).Value
    
    
    
    TextBox11.Text = Sheets("Data").Range("J" & BsNo).Value
    
    TextBox12.Text = Sheets("Data").Range("K" & BsNo).Value
    TextBox22.Text = Sheets("Data").Range("L" & BsNo).Value


End Sub








Private Sub SpinButton1_SpinDown()
On Error Resume Next
If ListBox1.ListIndex = ListBox1.ListCount - 1 Then Exit Sub
With Me.ListBox1
        .ListIndex = .ListIndex + 1
    End With
End Sub


Private Sub SpinButton1_SpinUp()
On Error Resume Next
If ListBox1.ListIndex = 0 Then Exit Sub
With Me.ListBox1
        .ListIndex = .ListIndex - 1
    End With
    End Sub
Sub refresh()
Dim sds As Long


ListBox1.ColumnCount = 1
sds = Sheets("Data").[a65536].End(xlUp).Row
ListBox1.List = Sheets("Data").Range("D2:D5000" & sds).Value


End Sub




Private Sub ToggleButton1_Click()
If ToggleButton1.Value = False Then
    Application.Visible = False
    ToggleButton1.BackColor = &H80FF&
   End If
   If ToggleButton1.Value = True Then
    Application.Visible = True
    ToggleButton1.BackColor = &H80FF&
End If
End Sub
 

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
You must log in or register to reply here.

Similar threads

C
  • Question Question
Need to add to my search worksheet
Replies
1
Views
100
craigwojo
C
I
  • Question Question
Worksheet value is updated only after userform is closed
2
Replies
13
Views
482
ipbr21054
I
J
  • Question Question
Excel VBA Print Name Tag from Userform
Replies
2
Views
326
Rhodie72
Rhodie72
M
  • Solved
Show message box on userform after sum or subtraction
Replies
2
Views
103
Maklil
M
I
  • Question Question
Advice to remove old code for a new code
Replies
2
Views
192
ipbr21054
I

Forum statistics

Threads
1,223,214
Messages
6,170,771
Members
452,353
Latest member
strainu

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