• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

HowTo optimise use of .select and reduce the 10 min that it takes to collate tables into 1

gerotutu

New Member
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

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 Sub

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
 
Hi ,

I don't think the slowness of execution has much to do with the Selects ; 600 tables in 10 minutes is a table a second , which is not really slow , though it can certainly be improved upon , but if you want that 600 tables will happen in 1 minute or less , then the factor of 10 which you expect will not come from eliminating the Selects.

Probably a different approach might be needed ; if you can upload a sample file with at least 60 tables and the existing code , you might get a more helpful answer.

Narayan
 
I'd be looking to use Advanced Filters to select the data as part of the code
It is blindingly fast

Would like to see the real data before making more comments
 
Back
Top