Question

I am Generating a New Sheets using macros. For a New Sheet generation , Data is retrieved from more than 4 MS Access DB. Each DB had minimum 200 field. My Macro code includes

  1. Cell locking
  2. Alignment and formatting
  3. One third of the cells in the sheet had a formulas
  4. Cell reference with other Workbooks

My problem is every sheet generation it takes minimum one hour to complete the hole process. But it seems to me it’s taking way too long.

I am already added the Application.ScreenUpdating = True to speed up the code but still it takes same time. How to do speed up the code , If you have any idea please guide me.

     `For Ip = 5 To  150
     resp = Range("B" & Ip).Value
     With ActiveSheet.QueryTables.Add(Connection:= _
    "ODBC;DSN=henkel2;DBQ=C:\Hl-RF\RSF-Temp.mdb;DriverId=25;FIL=MS Access;MaxBufferSize=2048;" _
    , Destination:=Range("IV4"))
    .CommandText = "select Vles from " & Shtname & " where cint(PrductID)='" & resp & "' and cint(DepotID) = '" & cnt1 & "' and Mnth = '" & mnths & "' and Type='" & typs & "'"
    .Name = "tab product"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceConnectionFile = _
    "C:\Hl-RF\tabct.odc"
    .Refresh BackgroundQuery:=False
    End With`


    Is There Is any way to Reduce the loop iteration time

Thanks In advance

Answer 1

There is some disucussion of this topic here.

Edit:
Ok, then the next step is to identify which parts of your code are taking the longest. The simplest way to do this is to make a copy of your code and just start measuring various parts like this:

Private Declare Function GetTickCount Lib "kernel32.dll" () As Long
Private mlngStrt As Long
Private mlngEnd As Long

Private Const u As Long = 10000000

Public Sub Example()
    Dim i As Long

    mlngStrt = GetTickCount
    For i = 0 To u
    Next
    mlngEnd = GetTickCount
    Debug.Print "Section1", mlngEnd - mlngStrt

    mlngStrt = GetTickCount
    ExampleSubCall
    mlngEnd = GetTickCount
    Debug.Print "ExampleSubCall", mlngEnd - mlngStrt

    mlngStrt = GetTickCount
    For i = 0 To (u * 1.5)
    Next
    mlngEnd = GetTickCount
    Debug.Print "Section2", mlngEnd - mlngStrt
    Debug.Print "Example Complete"
End Sub

Private Sub ExampleSubCall()
    Dim i As Long
    For i = 0 To (u * 0.75)
    Next
End Sub

This approach is fairly straight-forward. The drawback here is that you need to insert all of the timing statements and then turn around and remove them. Which is why I would work on a copy.

Once you know what parts are taking the longest you know where to focus your attention and what to ask for help with.