Return to Answer

added 156 characters in body

edited Jun 9, 2019 at 16:52

Sub Entry_Point was disabling screen updating, events and display alerts.
Sub Entry_PointExit_Point was enabling screen updating, events and display alerts.
It is being used for importing data from multiple filesmultiple files and to be finally placed in SheetShMN placed one below another

1 Sheet ShMN is being cleared with in loop For FileCnt = 1 To UBound(FiletoOpen) with line ShMN.Rows("2:" & ShMN.Rows.Count).ClearContents. I pulled out the line out forof the For loop for testing purpose.

2.The line ShMN.Cells(2, c).PasteSpecial modifed to ShMN.Cells(lastRow, c).PasteSpecial for placing data from each file one below another (This to avoid 1st files data to be overwritten by subsequent files data).

Finally as the cause of slow performance, it is found the Case Changing codes are placed inside header finding loop. ISo it is executing Number of files X Number of columns times. I pulled it out of even file loop toand placed just after completion of Data import.
Myrange was defined "B2:B" & Rows Count. I change it to Set MyRange = ShMN.Range("B2:B" & ShMN.Cells(Rows.Count, 2).End(xlUp).Row)

For Testing purpose, I used 5 files consisting same Data of 500 rows X 52 Columns with header. I have not used Calculation mode manual, Screen update disable etc (as I generally don't prefer these). You may use the techniques as per your requirement. It takes around 50 seconds to import all 5 files data and only another 3 odd seconds to change the case of B column (in my old laptop)

Finally iI tried the case changing with arrays to avoidminimize excel cell operationoperations as my ethic. You may use your process (commented out). it hardly affect performance in this case.

Sub Entry_Point was disabling screen updating, events and display alerts.
Sub Entry_Point was enabling screen updating, events and display alerts.
It is being used for importing data from multiple files and to be finally placed in SheetShMN placed one below another

1 Sheet ShMN is being cleared with in loop For FileCnt = 1 To UBound(FiletoOpen) with line ShMN.Rows("2:" & ShMN.Rows.Count).ClearContents. I pulled out the line out for the For loop for testing purpose.

2.The line ShMN.Cells(2, c).PasteSpecial modifed to ShMN.Cells(lastRow, c).PasteSpecial for placing data from each file one below another.

Finally as the cause of slow performance, it is found the Case Changing codes are placed inside header finding loop. I pulled it out of even file loop to just after completion of Data import.
Myrange was defined "B2:B" & Rows Count. I change it to Set MyRange = ShMN.Range("B2:B" & ShMN.Cells(Rows.Count, 2).End(xlUp).Row)

For Testing purpose I used 5 files consisting same Data of 500 rows X 52 Columns with header. I have not used Calculation mode manual, Screen update disable etc (as I generally don't prefer these). You may use the techniques as per your requirement. It takes around 50 seconds to import all 5 files data and only another 3 odd seconds to change the case of B column (in my old laptop)

Finally i tried the case changing with arrays to avoid excel cell operation as my ethic. You may your process (commented out). it hardly affect performance.

Sub Entry_Point was disabling screen updating, events and display alerts.
Sub Exit_Point was enabling screen updating, events and display alerts.
It is being used for importing data from multiple files and to be finally placed in SheetShMN one below another

1 Sheet ShMN is being cleared with in loop For FileCnt = 1 To UBound(FiletoOpen) with line ShMN.Rows("2:" & ShMN.Rows.Count).ClearContents. I pulled out the line out of the For loop for testing purpose.

Finally as the cause of slow performance, it is found the Case Changing codes are placed inside header finding loop.So it is executing Number of files X Number of columns times. I pulled it out of even file loop and placed just after completion of Data import.
Myrange was defined "B2:B" & Rows Count. I change it to Set MyRange = ShMN.Range("B2:B" & ShMN.Cells(Rows.Count, 2).End(xlUp).Row)

Finally I tried the case changing with arrays to minimize excel cell operations as my ethic. You may use your process (commented out). it hardly affect performance in this case.

Source Link

answered Jun 9, 2019 at 14:30

Ahmed AU

For testing your code following assumption are made

Sub Entry_Point was disabling screen updating, events and display alerts.
Sub Entry_Point was enabling screen updating, events and display alerts.
It is being used for importing data from multiple files and to be finally placed in SheetShMN placed one below another

according to the above assumption following modification was done

2.The line ShMN.Cells(2, c).PasteSpecial modifed to ShMN.Cells(lastRow, c).PasteSpecial for placing data from each file one below another.

Finally as the cause of slow performance, it is found the Case Changing codes are placed inside header finding loop. I pulled it out of even file loop to just after completion of Data import.
Myrange was defined "B2:B" & Rows Count. I change it to Set MyRange = ShMN.Range("B2:B" & ShMN.Cells(Rows.Count, 2).End(xlUp).Row)

My test code:

Option Explicit Sub test() Dim Tm As Long Dim FiletoOpen As Variant, ShDataN As Worksheet, ShMN As Worksheet Dim FileCnt As Long, SelectedBook As Workbook, MyRange As Range, cell As Range Tm = Timer Set ShDataN = ThisWorkbook.Sheets(1) Set ShMN = ThisWorkbook.Sheets(2) Dim lastRow As Long, LastTemp As Long 'lasttemp is "last row for table template Const StartRowTemp As Byte = 1 Dim c As Byte 'number of columns Dim GetHeader As Range 'find 'Call Entry_Point 'to prevent screen updating and display alert, the value is False 'Application.ScreenUpdating = False 'Application.EnableEvents = False Application.DisplayAlerts = False ' On Error GoTo Handle 'pick files to import - allow multiselect FiletoOpen = Application.GetOpenFilename _ (FileFilter:="Excel Files (*.xlsx), *.xlsx", Title:="Select Workbook to Import", MultiSelect:=True) If IsArray(FiletoOpen) Then 'delete the content from Analysis table ShMN.Rows("2:" & ShMN.Rows.Count).ClearContents ' moved out of For foleCnt loop For FileCnt = 1 To UBound(FiletoOpen) Set SelectedBook = Workbooks.Open(Filename:=FiletoOpen(FileCnt)) ShDataN.Cells.Clear SelectedBook.Worksheets("Client").Cells.Copy ShDataN.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats SelectedBook.Close False 'locate last empty row in Monthly Table lastRow = ShMN.Cells(Rows.Count, 1).End(xlUp).Row + 1 'locate last row in the new data LastTemp = ShDataN.Cells(Rows.Count, 1).End(xlUp).Row 'do while to find matching headers before copy paste c = 1 Do While ShMN.Cells(1, c) <> "" Set GetHeader = ShDataN.Rows(StartRowTemp).Find _ (What:=ShMN.Cells(1, c).Value, LookIn:=xlValues, MatchCase:=False, lookat:=xlWhole) If Not GetHeader Is Nothing Then ShDataN.Range(ShDataN.Cells(StartRowTemp + 1, GetHeader.Column), ShDataN.Cells(LastTemp, GetHeader.Column)).Copy ShMN.Cells(lastRow, c).PasteSpecial ' row 2 modified to lastRow ShMN.Rows("2:" & ShMN.Rows.Count).ClearFormats ' Call Range_Case 'to change the case on column Client's name after copying End If 'get Header c = c + 1 Loop Next FileCnt Debug.Print Timer - Tm Dim MyArr As Variant, FinalArr() As Variant, i As Long Set MyRange = ShMN.Range("B2:B" & ShMN.Cells(Rows.Count, 2).End(xlUp).Row) 'For Each cell In MyRange 'cell.Value = UCase(cell) 'Next cell MyArr = MyRange.Value ReDim FinalArr(LBound(MyArr, 1) To UBound(MyArr, 1)) For i = LBound(MyArr, 1) To UBound(MyArr, 1) FinalArr(i) = UCase(MyArr(i, 1)) Next MyRange.Value = FinalArr 'MsgBox "Data imported sucessfully", vbInformation, "General Information" End If 'isArray ShDataN.Cells.Clear 'With ShNote ' .Select ' .Range("A1").Select 'End With Application.ScreenUpdating = True Application.EnableEvents = True Application.DisplayAlerts = True Debug.Print Timer - Tm End Sub

Finally i tried the case changing with arrays to avoid excel cell operation as my ethic. You may your process (commented out). it hardly affect performance.