• 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.

How to optimize the code

Gunasekaran

Member
Hello,

I have written a code to prepare the source file data for JV entry preparation. It is working fine, but when I use more than 6000 records, it takes more than 3.20 minutes to run. I am really worried about this time.

Could someone please help me to modify this code? Thank you.

I thought this code could make much running time>>>

Code:
Sub Demo1bb8()
 Trg.Activate

Call DeleteRowsWithZeroValues_AI

Lllc = Trg.Cells(1, Columns.Count).End(xlToLeft).Column - 5
Lll = Trg.Cells(1, Columns.Count).End(xlToLeft).Column
lr = Trg.Range("a" & Rows.Count).End(xlUp).Row

ColumnNumber = Lll
NColumnNumber = Lll + 1
Numfcn = Lll + 2

'Convert To Column Letter
Crm = Split(Cells(1, ColumnNumber).Address, "$")(1)
Crmc = Split(Cells(1, NColumnNumber).Address, "$")(1)
Crmg = Split(Cells(1, Numfcn).Address, "$")(1)
    
     Alloc.Activate
    'Costc = Trg.Range("B1").Value
     P = Alloc.Range("A1").SpecialCells(xlCellTypeLastCell).Column - 3
    
    L = Enty.Range("A" & Rows.Count).End(xlUp).Row + 1
 
     Dim T$(4 To 5), Rd As Range, R&, C%, N%, S@(4 To 5, 0)
       '  L = 2:  T(4) = "Dr":  T(5) = "Cr"
        T(4) = "Dr":  T(5) = "Cr"
        
         With Di.UsedRange.Rows:  Set Rd = .Item("2:" & .Count).Columns:  End With
         'Enty.[A1].CurrentRegion.Offset(1).Clear
    With Application
        .ScreenUpdating = False
    With Trg.UsedRange.Rows
        For R = 3 To .Count
        For C = 4 To 5
           Dim rng As Range, FindString As String, ws As Worksheet
            FindString = Trg.Range("d2").Value

    On Error Resume Next
           Set rng = Smy.Range("A:A").Find(What:=FindString, LookIn:=xlValues, LookAt:=xlWhole).Offset(, 6)
On Error GoTo 0
    
    If rng = "D&D" Then
    
            If .Cells(R, C) Then
                
                N = IIf(.Cells(R, C) < "3", 1, P)
               .Cells(R, C).Copy Enty.Cells(L, 1).Resize(N)
               .Range("B1").Copy Enty.Cells(L, 4).Resize(N)
                Enty.Cells(L, 5).Resize(N) = "DND440"
                Enty.Cells(L, 6).Resize(N) = "ZZZZZ"
             If N = 1 Then
               .Cells(R, 2).Copy Enty.Cells(L, 8)
               Else
            Rd("B:C").Copy Enty.Cells(L, 2)
                Rd("D:E").Copy Enty.Cells(L, 5)
               .Rows(R).Columns("F:" & Crm).Copy
                Enty.Cells(L, 8).PasteSpecial 12, , , True
                Enty.Cells(L, 9).Resize(N) = T(C)
                S(C, 0) = S(C, 0) + .Cells(R, 2)
               End If
                Enty.Cells(L, 9).Resize(N) = T(C)
                S(C, 0) = S(C, 0) + .Cells(R, 2)
                L = L + N
            End If
Else
 If .Cells(R, C) Then
                N = IIf(.Cells(R, C) < "3", 1, P)
               .Cells(R, C).Copy Enty.Cells(L, 1).Resize(N)
               .Range("B1").Copy Enty.Cells(L, 4).Resize(N)
                Enty.Cells(L, 5).Resize(N) = Di.Range("D2")
                Enty.Cells(L, 6).Resize(N) = Di.Range("E2")
             If N = 1 Then
               .Cells(R, 2).Copy Enty.Cells(L, 8)
               Else
            
                Rd("B:C").Copy Enty.Cells(L, 2)
                
                Rd("D:E").Copy Enty.Cells(L, 5)
               .Rows(R).Columns("F:" & Crm).Copy
                Enty.Cells(L, 8).PasteSpecial 12, , , True
                Enty.Cells(L, 9).Resize(N) = T(C)
                S(C, 0) = S(C, 0) + .Cells(R, 2)
              
               End If
                Enty.Cells(L, 9).Resize(N) = T(C)
                S(C, 0) = S(C, 0) + .Cells(R, 2)
                L = L + N
            End If
            End If
        Next C, R
        
    End With
         Enty.[M2:M3] = S
        .CutCopyMode = False
        .Goto Enty.[A1], True
    End With
         Set Rd = Nothing

    Dim i As Long

On Error Resume Next
For i = Cells(Rows.Count, "H").End(xlUp).Row To 1 Step -1
    If Cells(i, "H").Value = 0 Then
        Rows(i).Delete
    End If
Next i
On Error GoTo 0
End Sub
 

Attachments

  • Community.zip
    877 KB · Views: 1
@shili12

Thank you for providing the information. Could you please execute the full Report code and share the updated file with me, if possible? I am seeking your support to expedite the ordering process since the entire code is taking 3.25 minutes, which is not useful for me and my team.

If you could review my full code and offer any suggestions, it would be greatly appreciated."

Thanks for your advance support and help...
 

Attachments

  • Community.zip
    877 KB · Views: 1
Based on the code you provided, I can see that it is performing multiple actions on the cells of the sheet. To improve the speed of the code, you can consider the following suggestions:
  1. Avoid using Activate and Select
The use of Activate and Select is not only inefficient, but it also makes your code less readable. Instead, you can directly refer to the sheet or the range you want to work with. For example, instead of using Trg.Activate, you can use Set Trg = Sheets("Trg").
  1. Avoid using copy and paste
The use of copy and paste is also inefficient. Instead, you can directly assign the values of the cells to a variable and then use that variable to assign the value to another range. For example, instead of using .Cells(R, C).Copy Enty.Cells(L, 1).Resize(N), you can use Enty.Cells(L, 1).Resize(N).Value = .Cells(R, C).Value.
  1. Use arrays to store and manipulate data
Working with arrays is much faster than working with cells. You can read the values of the cells into an array, manipulate the data, and then write the values back to the sheet.
  1. Use VBA functions and built-in Excel functions
Using VBA functions and built-in Excel functions can also help to improve the speed of your code. For example, instead of using a loop to find a cell, you can use the Find function.
  1. Turn off screen updating and calculation
Turning off screen updating and calculation can also help to improve the speed of your code. You can do this by setting the ScreenUpdating and Calculation properties of the Application object to False.

Code:
Sub Demo1bb8()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    Dim Trg As Worksheet
    Set Trg = Sheets("Trg")
  
    Dim Alloc As Worksheet
    Set Alloc = Sheets("Alloc")
  
    Dim Enty As Worksheet
    Set Enty = Sheets("Enty")
  
    Dim Di As Worksheet
    Set Di = Sheets("Di")
  
    Dim Smy As Worksheet
    Set Smy = Sheets("Smy")
  
    Dim myArray As Variant
    myArray = Trg.Range("A3:E6000").Value
  
    Dim P As Long
    P = Alloc.Cells(Alloc.Rows.Count, 1).End(xlUp).Row - 1
  
    Dim L As Long
    L = Enty.Cells(Enty.Rows.Count, 1).End(xlUp).Row + 1
  
    Dim T(4 To 5) As String
    T(4) = "Dr"
    T(5) = "Cr"
  
    Dim S(4 To 5, 0) As Long
  
    Dim R As Long
    For R = 1 To UBound(myArray)
        If myArray(R, 4) = "D&D" Then
            If myArray(R, 5) <> "" Then
                Dim N As Long
                N = IIf(myArray(R, 5) < "3", 1, P)
              
                Enty.Cells(L, 1).Resize(N).Value = myArray(R, 4)
                Enty.Cells(L, 4).Resize(N).Value = myArray(R, 5)
                Enty.Cells(L,
Kindly provide full Code, i am not able to write after this, even I am not good and strong in VBA.. I am Just Learning person.
 
Last edited:
Gunasekaran
#1 reply - it takes more than 3.20 minutes to run.
#6 reply - its taking more than 3.50 hours
Would it better to use Your original solution ?
 
How many time if you do it manually ? ....​
Not a surprise the way my original procedure was modified !​
Restart from my procedure and apply post #2.​
As a reminder an Excel VBA procedure can be 100 times slower than doing the same under a database software …​
 
did you run and check my entire code. Basicially just transpose, the copy and paste method, then prepare the entry, there is no much complex codes here. But Number of line item will more. It mean, more than 6000 times loops will run. thats why

delay...

can you suggess me if possible better code...
 
@mar - to Answer Post 7, it will take more than 3+ Hours. so i cannot give accurate Hours. but typically its more time. Uset not happy to run this much time..
 
It's what happens when using Excel rather than a database software which needs around 2 minutes for the same …​
Yes, Excel is slow as it is very not a database software !​
Did you test on several computers ?​
 
So again it's time to review your data design in order to reduce the necessary operations.​
Or obviously use a database software rather than Excel …​
 
Back
Top