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
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:
{=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