Dear friends, I have the following issue with a macro that collates near 600 tables (5x13) and paste them in different sheets in order.
In other words, the macro builds a DB with hundreds of tables distributed in several sheets.
Because it needs to copy and paste so many cells the macro became really really inefficient changing sheets and extracting all data. It can take literally 10 minutes the whole process.
I don't know how to optimise. I have looked for answers the last 2 weeks but I have made really tiny improvements. I still use for example many sheets().select
Please... what can I do? The code is the following
Take note that in "LoadTable" you have by row the info that you need to collate the data in the other sheets, such as
- Sheet name of source
- Initial and ending cell
- Sheet name of destination
- A cell for adding a column (which is optional and it will add in every row in the last column whatever is put there)
- And a flag YES / NO so I can choose which lines to load
The macro basically in few steps
1- cleans the destiny sheets
2- looks for the tables in the ranges and sheets written in LoadTable and it pastes those tables in the destiny sheet
3- for each line or row copied it adds also the name of the table in the first column
4- and if there is an additional column that want to be added to the db that is being built, it does it for every row in the last column
What can I do to optimise the macro? Many thanks
Geronimo
In other words, the macro builds a DB with hundreds of tables distributed in several sheets.
Because it needs to copy and paste so many cells the macro became really really inefficient changing sheets and extracting all data. It can take literally 10 minutes the whole process.
I don't know how to optimise. I have looked for answers the last 2 weeks but I have made really tiny improvements. I still use for example many sheets().select
Please... what can I do? The code is the following
Code:
Sub Extractor()
'
' byYearExtractor Macro
'
Dim i As Integer
Dim n As Integer
Dim Range2 As Range, Range1 As Range
Dim Source As String, Destiny As String, TableName As String, AdditionalColumn As String
Dim UniqueDestinyArray As Variant, FullDestinyArray As Variant
Dim flagsSource As Boolean, flagDestiny As Boolean
Dim ws As Worksheet
On Error GoTo errHandler
Application.ScreenUpdating = False
Set ws = ActiveSheet
Sheets("LoadTable").Select
NumRows = Range("A1", Range("A1").End(xlDown)).Rows.Count - 1
If NumRows = 0 Or NumRows > 1000 Then
MsgBox ("insert a table to load or less than 500 tables")
Exit Sub
End If
'Clear tables in Destiny Sheets
FullDestinyArray = Range("E2", Range("E2").End(xlDown))
UniqueDestinyArray = UniqueItems(FullDestinyArray, False)
For i = LBound(UniqueDestinyArray) + 1 To UBound(UniqueDestinyArray)
Destiny = UniqueDestinyArray(i)
If Sheets(Destiny).Visible = False Then flagDestiny = True
If Sheets(Destiny).Visible = False Then Sheets(Destiny).Visible = True
Sheets(Destiny).Select
Range("A2:ZZ65563").ClearContents
Range("A2").Select
Next
'Load tables
Sheets("LoadTable").Select
Range("A2").Select
For i = 0 To NumRows - 1
Do While ActiveCell(i + 1, 8).Value = "NO"
i = i + 1
Loop
If ActiveCell(i + 1, 8).Value = "YES" Then
Set Range1 = ActiveCell(i + 1, 2)
'MsgBox (Range1)
Set Range2 = ActiveCell(i + 1, 3)
'MsgBox (Range2)
Source = ActiveCell(i + 1, 1)
'MsgBox Source
Destiny = ActiveCell(i + 1, 5)
'No of columns
ActiveCell(i + 1, 4).Value = Range(Range1 & ":" & Range2).Columns.Count
numberColumns = Range(Range1 & ":" & Range2).Columns.Count
'No of rows
numberRows = Range(Range1 & ":" & Range2).Rows.Count
'Optional column
AdditionalColumn = ActiveCell(i + 1, 7)
If Sheets(Source).Visible = False Then flagSource = True
If Sheets(Source).Visible = False Then Sheets(Source).Visible = True
'Get table name
'Sheets(Source).Select
TableName = Sheets(Source).Range(Range1).Offset(-1, 0)
Sheets(Source).Range(Range1).Offset(-1, 0).Copy
'Sheets("LoadTable").Select
ActiveCell(i + 1, 6).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Get data table
Sheets(Source).Range(Range1 & ":" & Range2).Copy
If Sheets(Destiny).Visible = False Then flagDestiny = True
If Sheets(Destiny).Visible = False Then Sheets(Destiny).Visible = True
Sheets(Destiny).Select
Range("B65536").End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Range("A65536").End(xlUp).Activate
For n = 0 To Range(Range1 & ":" & Range2).Rows.Count - 1
ActiveCell.Offset(n + 1, 0).Value = TableName
Next
'If AdditionalColumn <> "" Then Range("A1").End(xlDown).End(xlToRight).Offset(0, 1).End(xlUp).Activate
If AdditionalColumn <> "" Then
Range("A1").End(xlDown).Offset(-numberRows, numberColumns + 1).Select
For Z = 0 To Range(Range1 & ":" & Range2).Rows.Count - 1
ActiveCell.Offset(Z + 1, 0).Value = AdditionalColumn
Next
End If
AdditionalColumn = ""
Range("A1").Select
If flagSource = True Then Sheets(Source).Visible = False
If flagSource = True Then flagSource = False
If flagDestiny = True Then Sheets(Destiny).Visible = False
If flagDestiny = True Then flagDestiny = False
Sheets("LoadTable").Select
Range("A2").Select
End If
Next
ws.Activate
Sheets("LoadTable").Select
Application.ScreenUpdating = True
errHandler:
Application.ScreenUpdating = True
End SubTake note that in "LoadTable" you have by row the info that you need to collate the data in the other sheets, such as
- Sheet name of source
- Initial and ending cell
- Sheet name of destination
- A cell for adding a column (which is optional and it will add in every row in the last column whatever is put there)
- And a flag YES / NO so I can choose which lines to load
The macro basically in few steps
1- cleans the destiny sheets
2- looks for the tables in the ranges and sheets written in LoadTable and it pastes those tables in the destiny sheet
3- for each line or row copied it adds also the name of the table in the first column
4- and if there is an additional column that want to be added to the db that is being built, it does it for every row in the last column
What can I do to optimise the macro? Many thanks
Geronimo
