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

Status
Not open for further replies.
D

Dobbo222

New Member
Joined
May 22, 2017
Messages
12
I have a Workbook containing various sheets. One is populated with data from a Userform to a sheet called "SURVEYS". Another sheet called"Quote" then calls data from that sheet using an array formula to extract values when a unique survey ref is entered into cell C3. The Array is in a number of cells and can return data from a number of lines if there is more than one occurrence of the "survey ref". 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)),13)),"",INDEX('SURVEYS'!$B$2:$W$49999,SMALL(IF('SURVEYS'!$B$2:$W$49999=$C$3,ROW('SURVEYS'!$B$2:$W$49999)),ROW(1:1)),13))}

This works fine if I keep it in a separate workbook but if the sheet is in the same workbook the Userform is in the processing of the Userform slows up and takes ages rather than instantaneous. I enclose the code for the userform to see if anyone can shed light on why? My guess is the array is calculating values as the userform data is being posted how can i stop that happening and call the array only when the data is entered into cell C3 of the quote sheet??
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

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce
Sort by date Sort by votes
Status
Not open for further replies.

Similar threads

M
  • Question
Add in VBA Code to check zip code against pre-determined list
Replies
0
Views
185
mikefisher
M
P
  • Question
ListBox Click to textbox & delete row
Replies
0
Views
363
pure vito
P
S
  • Solved
User Form Textbox looping
2
Replies
12
Views
638
sjtjr73
S
P
  • Question
Userform Listbox Edit Rows Within Sheet
Replies
1
Views
482
pure vito
P
A
  • Question
Autofilter code based on username
Replies
1
Views
192
aabrazil1
A

Forum statistics

Threads
1,215,772
Messages
6,126,814
Members
449,339
Latest member
Cap N

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