Everything is working fine; it just works too slowly. Specially, when there are 3 workbooks that a single Userform needs to open and update 3 ListBoxes.Here I have a class that I use to:Open a Workbook (as read-only), copy its contents into an array.I pass this array to a ListBox, so the user can see what is the content of that Workbook.The user can now choose what record/s he/she wants to update.With the help of a Column named Trans_no, where there are unique numbers. I update the the that entirerow (depending on the number of Controls associated to each Column.)Given the Trans_no, I can locate the cell/row that needs updating (using sub LOOK_FOR), or the cell below the last non-blank cell in Trans_no Column.I loop through the collection of controls with sub PASS_THIS.Delete the record, depending on the selected Trans_No.Here is a sample userform:Here is the code for class cls_Connection:Private sCon As String                      '// Connection stringPrivate eApp As Excel.Application           '// New instance of Excel ApplicationPrivate eWB As Excel.Workbook               '// The workbook in Excel ApplicationPrivate eWS As Worksheet                    '// The worksheet in Excel WorkbookPrivate bRonly As Boolean                   '// Is the workbook ReadOnly?Private bOpen As Boolean                    '// Is the connection open?Private vDa() As Variant                    '// The data from the worksheetPrivate LastMod As Date                     '// The time when the last change took placeProperty Get timeLastModified() As Date     '// this property doesnt have    timeLastModified = LastMod              '// a let proerty. so the userEnd Property                                '// wont be able to change its valueProperty Get isReadOnly() As Boolean        '// This property doesn't have    isReadOnly = bRonly                     '// a let property. so the userEnd Property                                '// wont be able to change its valueProperty Let ConnectionString(ByVal FilePath As String)    sCon = FilePath                         '// This property sets the connectionEnd Property                                '// string.Property Get ConnectionString() As String    ConnectionString = sCon                 '// This property shows the connectionEnd Property                                '// string.Property Get Data() As Variant              '// There is only get data property.    Data = vDa()                            '// So the user won't be able toEnd Property                                '// set/change its value.Private Sub OpenConnection(ByRef sPass As String, Optional ByRef bRead As Boolean = False)    Set eApp = New Excel.Application        '// Creating new instance of excel    On Error GoTo ErrHandler                '// basic error handler    Set eWB = eApp.Workbooks.Open(sCon, , bRead, , sPass, , True)    Set eWS = eWB.Sheets(1)                 '// sets new worksheet    bOpen = True                            '// is it open?    bRonly = eWB.ReadOnly                   '// is it opened as readonly?    LastMod = eWB.BuiltinDocumentProperties(Last Save Time)    Exit Sub                                '// exits the sub after updating last modErrHandler:    MsgBox Err.Description, vbCritical, Err.Number &  - Call a programmer!    EndEnd SubPrivate Sub CloseConnection(ByRef bChanges As Boolean)    On Error GoTo ErrHandler                '// basic error handling    If Not bRonly Then    eWB.Save    LastMod = eWB.BuiltinDocumentProperties(Last Save Time)    End If    eWB.Close bChanges                      '// Closes the workbook and save it as needed.    eApp.Quit                               '// Quits the new instance of Excel.    bOpen = False                           '// changes the global boolean    Exit Sub                                '// exits the subErrHandler:    MsgBox Err.Description, vbCritical, Err.Number &  - Call a programmer!End SubPublic Sub UpdateMe(ByRef Password As String)  OpenConnection Password, True             '// Opens the workbook.(readonly)    If eWS Is Nothing Then Exit Sub         '// Exit if there is no worksheet.    Update                                  '\\ calls the update routine  CloseConnection False                     '// Closes the workbook.End SubPrivate Sub Update()  If Not bOpen Then Exit Sub                '// checks if there is an open wb  Erase vDa()                               '// clears the database  With eWS                                  '// updates it by getting the last row+cols    vDa() = .Range(.Cells(1, 1), .Cells(GET_LAST(Row, .Cells), .Cells.End(xlToRight).Column))  End WithEnd SubPublic Sub UpdateRecords _  (ByVal Password As String, ByVal whatToDo As xlAddNewEditDelete, _   Optional ByVal transNo As String, Optional ByRef cControls As Collection)  Dim strMsg As String  Dim rActive As Range    If CanWeProceed(sCon) Then              '\\ calls the canweproceed FUNCTION    If Not whatToDo = AddNew Then           '// basic checking if arguements      If Len(Trim(transNo)) = 0 Then Exit Sub ' for addnew records are    End If                                  '// present    If Not whatToDo = Delete Then           '// basic checking if arguements      If cControls Is Nothing Then Exit Sub '// for delete records are    End If                                  '// present    OpenConnection Password, False          '\\ opens the workbook that will be updated    If bRonly Then GoTo FileOpen            '// do not proceed if opened as readonly    Select Case whatToDo                    '// select case depending on what the      Case AddNew                           '// in case the user want to add new records        Set rActive = eWS.Cells(GET_LAST(Row, eWS.Range(A:A)) + 1, 1)        PASS_THIS cControls, rActive        '// after locating the lastrow, pass the data      Case Edit                             '// in case the user want to edit        Set rActive = LOOK_FOR(transNo)     '// locate the trans# then update        If Not rActive Is Nothing Then PASS_THIS cControls, rActive      Case Delete                           '// in case the user want to delete        Set rActive = LOOK_FOR(transNo)     '// locate the trans# then delete        If Not rActive Is Nothing Then rActive.EntireRow.Delete shift:=xlUp    End Select        Update                              '\\ calls the update routine    CloseConnection True                    '\\ closes the workbook and save the changes    End If    Exit SubFileOpen:  MsgBox Request denied! Encountered a critical error! & vbCrLf & _  Do not close this error message., vbCritical,  Call a programmer!End SubPrivate Sub PASS_THIS(ByRef cControls As Collection, ByVal rWhere As Range)  Dim int1 As Integer                       '// this sub takes a range object for update  With cControls                            '// of controls and passes it to the database    For int1 = 1 To .Count                  '// loops through the control.      rWhere.Offset(, int1 - 1).value = .Item(int1).value    Next                                    '// pass each value to the worksheet  End WithEnd SubPrivate Function LOOK_FOR(ByRef strTrans As String) As Range  Dim bFound As Boolean                     '// this sub returns a range object  Dim loop1 As Long                         '// if there is a valid transaction  Dim rEach As Range                        '// number present in the database    Set LOOK_FOR = eWS.Cells(GET_LAST(Row, eWS.Range(A:A)) + 1, 1)    With eWS                                '// the default range is the last row      For loop1 = 2 To .UsedRange.rows.Count + 1        Set rEach = .Cells(loop1, 1)        '// loops through the used range        If rEach.value = strTrans Then      '// and check each transaction #          Set LOOK_FOR = rEach              '// if there is an equivalent,          Exit Function                     '// return that range and exit function.        End If                              '// if the trans# to be updated is not      Next                                  '// found, this will give the last row    End With                                '// and put the data in that row.End FunctionPrivate Function CanWeProceed(FilePath As String) As Boolean  Dim FileNo As Integer, ErrNo As Integer  On Error Resume Next                      '// Skips one error.    FileNo = FreeFile()                     '// Gets an available file number.    Open FilePath For Input Lock Read As #FileNo    Close FileNo                            '// Closes the file.    ErrNo = Err                             '// Resumes error handling.  On Error GoTo 0                           '// Resumes error handling.  CanWeProceed = ErrNo = 0End FunctionHere is the code for class cls_NewRecords:This class represents the entirety of the Userform.Public WithEvents ContentBox As MSForms.ListBox             '// Listbox containing the dataPublic WithEvents FilterButton  As MSForms.CommandButton    '// Start to look for.Public WithEvents FilterColumn As MSForms.ComboBox          '// Where to look for.Public FilterBox As MSForms.TextBox                         '// What to look for.Public WithEvents buttonSave As MSForms.CommandButton       '// Save button.Public WithEvents buttonDelete As MSForms.CommandButton     '// Delete button.Public WithEvents buttonClear As MSForms.CommandButton      '// Edit button.Public WithEvents buttonRefresh As MSForms.CommandButton    '// Edit button.Private ControlCollection As CollectionPrivate vDatabase() As Variant'Private vDetails() As Variant                               '// what is this for?Private vHeaders() As VariantPrivate ColumnOfEmpNumber As IntegerPrivate ColumnToFilter As IntegerPrivate DisableEvents As BooleanPrivate DatabaseConnection As cls_ConnectionPrivate ConnectionString As StringPrivate ExcelPassword As StringPrivate ColumnWidths As StringPrivate DatabaseLastMod As DatePrivate Const MsgBoxHeader As String = MasterlistProperty Set Controls(ByVal cols As Collection)    Set ControlCollection = colsEnd PropertyPublic Sub InitializeConnection(ByVal strCon As String, ByVal strPass As String)  ConnectionString = strCon  ExcelPassword = strPass  Set DatabaseConnection = New cls_Connection  With DatabaseConnection    .ConnectionString = ThisWorkbook.Path & \ & ConnectionString    .UpdateMe ExcelPassword    vDatabase() = .Data  End WithEnd SubPublic Sub InitializeListBox(Optional ByVal strWidths As Variant)  ColumnWidths = strWidths  With ContentBox    RefreshList    If Not IsMissing(strWidths) Then .ColumnWidths = strWidths    .ColumnCount = UBound(vDatabase(), 2) + 1  End With    vHeaders() = TRANSPOSEARR(vDatabase())    ReDim Preserve vHeaders(LBound(vHeaders(), 1) To UBound(vHeaders(), 1), 1 To 1)    FilterColumn.List() = vHeaders()    TrackingDetails AddNewEnd SubPrivate Sub RefreshList()  With DatabaseConnection    vDatabase() = .Data    ContentBox.List() = vDatabase()    DatabaseLastMod = .timeLastModified  End WithEnd SubPrivate Sub ClearList()  Dim int1 As Integer  With ControlCollection    For int1 = 1 To .Count      If TypeName(.Item(int1)) = ComboBox Then        .Item(int1).ListIndex = 0      Else        .Item(int1) =       End If    Next  End With  ContentBox.Locked = FalseEnd SubPrivate Sub ButtonClear_Click()  RefreshList  ClearList  TrackingDetails AddNewEnd SubPrivate Sub ButtonRefresh_Click()  With DatabaseConnection    .UpdateMe ExcelPassword    RefreshList  End WithEnd SubPrivate Sub ButtonDelete_Click()  Dim strMsg As String    strMsg = The database is not updated. & vbCrLf & _             Would you like to refresh your database?    ManageRecords Delete, ControlCollection.Item(1), ControlCollection, strMsgEnd SubPrivate Sub ButtonSave_Click()  Dim strMsg As String    strMsg = You are about to add/update a record. & vbCrLf & _             Are you sure you want to proceed?    With ControlCollection      On Error GoTo EarlyExit      If CDbl(.Item(1).value) > vDatabase(UBound(vDatabase(), 1), 1) Then        ManageRecords AddNew, .Item(1), ControlCollection, strMsg      Else        TrackingDetails Edit        ManageRecords Edit, .Item(1), ControlCollection, strMsg      End If    End With    Exit SubEarlyExit:  If Err.Number = 13 Then  MsgBox You are trying to save an invalid transaction number, vbInformation, Err.Number &  - Select a valid record.  Else  MsgBox Err.Description, vbCritical, Err.Number &  - Call a programmer!  End IfEnd SubPrivate Sub ContentBox_Click()  Dim i1 As Integer, a() As Variant, strTrans As String    With ContentBox      If .ListIndex < 1 Then Exit Sub      strTrans = .List(.ListIndex, LBound(.List(), 2))      a() = CLEANARR(vDatabase(), strTrans, 1, False, True, True)    End With    With ControlCollection      For i1 = 1 To .Count        .Item(i1).value = a(2, i1)      Next    End WithEnd SubPrivate Sub FilterColumn_Change()  Dim sTemp As String, i As Integer, a() As Variant    sTemp = FilterColumn.value    If Len(Trim(FilterColumn.value)) = 0 Then Exit Sub    For i = LBound(vHeaders(), 1) To UBound(vHeaders(), 1)      If sTemp = vHeaders(i, 1) Then ColumnToFilter = i    NextEnd SubPrivate Sub FilterButton_Click()  If ContentBox.Locked Then Exit Sub  Dim a() As Variant, sTemp As String    sTemp = CStr(FilterBox.value)    If Len(Trim(sTemp)) = 0 Then      ContentBox.List() = vDatabase()      Exit Sub    Else      OPTIMIZE_VBA True      a() = CLEANARR(vDatabase, sTemp, ColumnToFilter, False, False, True)      ContentBox.List = a()      OPTIMIZE_VBA False    End IfEnd SubPrivate Sub ManageRecords(ByVal whatToDo As xlAddNewEditDelete, _ByRef transNo As String, ByRef colsControl As Collection, strMsg As String)  Dim iRefresh As Byte, iProceed As Byte    If Not isDatabaseLatest Then      iRefresh = MsgBox(The database is not updated. & vbCrLf & _                        Would you like to refresh your database?, _                        vbInformation + vbOKCancel, MsgBoxHeader)      If iRefresh = 1 Then ButtonRefresh_Click    End If      iProceed = MsgBox(strMsg, vbInformation + vbOKCancel, MsgBoxHeader)      If iProceed = 1 Then        OPTIMIZE_VBA True          DatabaseConnection.UpdateRecords ExcelPassword, whatToDo, ControlCollection.Item(1), ControlCollection          ButtonClear_Click        OPTIMIZE_VBA False      End IfEnd SubPrivate Sub TrackingDetails(ByRef whatToDo As xlAddNewEditDelete)  With ControlCollection  If whatToDo = AddNew Then .Item(1).value = GiveMax(vDatabase()) + 1  .Item(2).value = Now()  End WithEnd SubPrivate Function isDatabaseLatest() As Boolean    isDatabaseLatest = Not (CDate(FileDateTime(ThisWorkbook.Path & \ & ConnectionString)) < DatabaseLastMod)End FunctionPrivate Function GiveMax(v() As Variant) As LongDim i As Long, H As LongOn Error Resume Next  For i = LBound(v(), 1) To UBound(v(), 1)    If v(i, 1) > H Then H = v(i, 1)  NextGiveMax = HEnd FunctionHere is the code for the Userform:On initilize of the userform I create a variable as cls_NewRecords, set its properties and controls, then add them to a global collection.Private CollectionOfClasses As CollectionPrivate Sub UserForm_Initialize()Dim colControl As CollectionDim int1 As IntegerDim ThisUserform As cls_NewRecordsDim ThisHelper As cls_RecordHelperDim limitFormat As cls_FormattedControlsSet ThisUserform = New cls_NewRecords   '<~ set this variable a new classSet CollectionOfClasses = New Collection '<~ define the public collection as new collectionSet colControl = New Collection         'collection of controls. their index refers to what column they will be placed.For int1 = 1 To 20 colControl.Add Me.Controls(Col & int1), TextBox & int1NextWith ThisUserform  Set .ContentBox = listFilter          '<~ the listbox that represents the workbook  Set .FilterBox = textFilter           '<~ 'text' we use to filter the workbook  Set .FilterColumn = selectFilter      '<~ ComboBox that the user chooses what column should the 'text' looked for  Set .FilterButton = buttonFilter      '<~ start looking for 'text' in the chosen column  Set .buttonSave = buttonSave          '<~ save changes ( new record/edit record)  Set .buttonClear = buttonClear        '<~ clear the userform.  Set .buttonDelete = buttonDelete      '<~ delete the record.  Set .buttonRefresh = buttonRefresh    '<~ refresh the list. (if there are changes done by other user)  Set .Controls = colControl  .InitializeConnection data\att.xlsx, G.Cells(1, 1).Value    '<~ sheet 'G' range 'A1' is where the password for the workbook is stored.  .InitializeListBox 0;0;0;0;30;110;50;30;65;100;0;0;0;0;0;0;0;0;0;0;0;0 '<~ to hide unnecessary columns.End WithCollectionOfClasses.Add ThisUserform    '<~ adds this class to the collectionSet ThisUserform = Nothing              '<~ minor cleanupSet colControl = Nothing                '<~ minor cleanupWith Col9  .AddItem Whole Day  .AddItem Half Day  .AddItem Under Time  .AddItem Late  .AddItem SuspensionEnd WithselectFilter.ListIndex = 5With Col4.AddItem Direct.AddItem NonDirect.ListIndex = 0End WithEnd SubThe following function/sub are located in a regular module.This is the OPTIMIZE_VBA Sub:Public Sub OPTIMIZE_VBA(ByVal isOn As Boolean)Dim bHolder As BooleanbHolder = Not isOnWith Application  .DisplayAlerts = bHolder  .ScreenUpdating = bHolder  .EnableEvents = bHolder  .Calculation = IIf(isOn, xlCalculationManual, xlCalculationAutomatic)  .Calculate    If .Version > 12 Then .PrintCommunication = bHolderEnd WithEnd SubThis is the GET_LAST Function:Public Function GET_LAST(c As Choice, rng As Range)Dim o As XlSearchOrderDim r As Range  o = xlByRows                    '<~~ default value  If c = 2 Then o = xlByColumns   '<~~ change it if looking for column  Set r = rng.Find(What:=*, after:=rng.Cells(1), LookIn:=xlFormulas, _          LookAt:=xlPart, SearchOrder:=o, SearchDirection:=xlPrevious, _          MatchCase:=False)  If r Is Nothing Then Set r = rng.Cells(1, 1)    '<~~ if we found nothing give A1  If c = Row Then GET_LAST = r.Row  If c = Column Then GET_LAST = r.Column  If c = Cell Then GET_LAST = rng.Parent.Cells(GET_LAST(Row, rng), GET_LAST(Column, rng)).Address(0, 0)End FunctionThis is the CLEANARR Function:That receives a 2D array and loops from lbound upto ubound of 1stD.Filters the array with the given column number and criteria ('s' as string).Public Function CLEANARR _   (ByRef v() As Variant, ByVal s As String, ByVal c As Integer, _    Optional ByVal RemoveMatch As Boolean = False, _    Optional ByVal ExactMatch As Boolean = False, _    Optional ByVal KeepHeader As Boolean = True) _As VariantDim a(), r As Long, i1 As Long, i2 As LongDim StartofLoop As Integer, deleteRecord As BooleanReDim a(LBound(v(), 1) To UBound(v(), 1), LBound(v(), 2) To UBound(v(), 2))StartofLoop = LBound(v(), 1)If KeepHeader Then Call GIVE_HEADER(a(), r, StartofLoop, v())For i1 = StartofLoop To UBound(v(), 1)  If ExactMatch Then    If Not (UCase(Format(v(i1, c), 0)) = UCase(Format(s, 0))) = RemoveMatch Then deleteRecord = True  Else    If Not InStr(1, v(i1, c), s, vbTextCompare) = RemoveMatch Then deleteRecord = True  End If  If deleteRecord Then    r = r + 1    For i2 = LBound(v(), 2) To UBound(v(), 2)      a(r, i2) = v(i1, i2)    Next    deleteRecord = False  End IfNextCLEANARR = REDUCEARR(a())End FunctionThis is the TRANSPOSEARR Function:Public Function TRANSPOSEARR(ByRef v() As Variant) As VariantDim rows, cols As LongDim s() As VariantReDim s(LBound(v(), 2) To UBound(v(), 2), LBound(v(), 1) To UBound(v(), 1))For rows = LBound(v(), 1) To UBound(v(), 1)  For cols = LBound(v(), 2) To UBound(v(), 2)    s(cols, rows) = v(rows, cols)  NextNextTRANSPOSEARR = s()End Function
Class to update a userform with an external workbook and vice versa
performance;vba;excel