Seeking Help to Optimize Macro Code for Faster Performance

[Gunasekaran]

Hello everyone,

I have been learning a lot from this amazing forum and have come across many short codes and new techniques. Recently, I created a macro code for Team Entry Preparation. However, I noticed that the code takes more than 1 hour to run when dealing with a large dataset. I believe this is because I am using normal classic code instead of faster or array-level code.

I am reaching out to the experts here to see if anyone could kindly take a look at my code and help me recreate it in a shorter and more efficient version. This optimization would greatly reduce the time required for my month-end work.

I have attached the completed code workbook for your reference, and the module code name is "Sub DataTranspose_Optimized_027()".

Thank you in advance for your support and expertise!

 

[Marc L]

Hello, which VBA procedure ? How can it be possible it lasts one hour with this attachment ?!​

​

 

[Gunasekaran]

Hello, which VBA procedure ? How can it be possible it lasts one hour with this attachment ?!​

​

Hello Sir,

Good evening. I've completed the coding for the module named "Sub DataTranspose_Optimized_027()" using basic VBA. However, due to the sheet volume of the original source data, which has more than 6500 lines (with each line representing a unique Staff No.), I'm unable to share the entire file.

Here's a quick rundown of the entire process:

1. Copy and paste the source data into the "Pay Summary" sheet.
2. Retain only records for the company code "027" using a VLOOKUP function and delete all other lines.
3. Transpose each employee record while making the necessary data modifications.
4. In the "WS" sheet, retain only project-related data and delete the rest.
5. Move all the modified debit/credit data along with their respective amounts to the "JV" sheet. ( i thought this area getting more time, before all the four steps small processes, but i am using normal code instead of an array or other Technique code Sir )

This completes the entire process. Your continued support and guidance is much appreciated.

 

[Marc L]

With only 6 500 lines so that should not be so slow but as I can't test without the same data …​

​

1 & 2. Obviously do not copy all the data but only the necessary just using a filter or better an advanced filter.​

3. ?​

4. The same as 1 & 2.​

5. Why move ? Just copy the necessary without the need to move anything …​

​

 

[vletm]

Gunasekaran​

Could it be more clear that You'll send here two files?
The 1st file will show before 'run Your code'
and 2nd file will show after 'run Your code' ( this is same as expected results).
As Marc L above wrote - why should 'new' code copy, paste and so on?

 

[Gunasekaran]

Sub DataTranspose_Optimized_027()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.DisplayStatusBar = True
Dim netSalaryColumn As Long

   Dim wsName As String
    wsName = "Financial Account Codes"
    On Error Resume Next
        If Evaluate("ISREF('" & wsName & "_Temp'!A1)") Then
            Sheets(wsName & "_Temp").Cells.Copy Destination:=Sheets(wsName).Cells
            Sheets(wsName & "_Temp").Delete
        End If
    On Error GoTo 0
    
    Sheets(wsName).Copy After:=Sheets(wsName)
    ActiveSheet.Name = wsName & "_Temp"

    On Error Resume Next
       Sheets("Pay Summary").Delete
    On Error GoTo 0

Sheets("Source Data").Copy After:=Sheets("Source Data")
ActiveSheet.Name = "Pay Summary"

    With ThisWorkbook.Sheets("Pay Summary").Rows(1)
        netSalaryColumn = .Find("NET SALARY", , , xlWhole).Column
    End With
    
    If netSalaryColumn > 0 Then
     ThisWorkbook.Sheets("Pay Summary").Range(Columns(netSalaryColumn + 1), Columns(Columns.Count)).Delete
    End If
    
    Set FinAccCodes = ThisWorkbook.Sheets("Financial Account Codes")
    
     With FinAccCodes
        .AutoFilterMode = False
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Range("A1:A" & lastRow).AutoFilter Field:=1, Criteria1:="<>027"
        .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .AutoFilterMode = False
    End With


Dim R As Range, Vin As Variant, Vrw As Variant, Vout As Variant, i As Long, NxRw As Long
Set Wk = ThisWorkbook.Sheets("WS")
Set Srk = ThisWorkbook.Sheets("Pay Summary")
timetaken = Now()

For Each ws In ActiveWorkbook.Worksheets
If ws.AutoFilterMode = True Then
ws.AutoFilterMode = False
End If
Next ws


Wk.UsedRange.Clear
Enty.UsedRange.Offset(1).Clear

    Dim arr As Variant
    With Srk.Range("M1", Srk.Cells(Srk.Rows.Count, "M").End(xlUp))
        .Value = Application.Trim(.Value)
    End With
lastCol = Srk.Cells(1, Columns.Count).End(xlToLeft).Column
ColumnLetter = Split(Srk.Cells(1, lastCol).Address, "$")(1)


    With Srk.Rows(1)
        workLocationColumn = .Find("Work Location", , , xlWhole).Column
    End With
   lastRow = Srk.Cells(Srk.Rows.Count, "A").End(xlUp).Row
    
    With Srk
  
    .Columns("N").Insert Shift:=xlToRight
    .Range("N1").Value = "x"
    .Range("N2:N" & lastRow).FormulaR1C1 = "=VLOOKUP(RC[-1],'Site Details'!C[-13]:C[-12],2,0)"

    On Error Resume Next
    .Range("A1:N" & lastRow).AutoFilter Field:=14, Criteria1:="<>027", Operator:=xlFilterValues
    If Application.WorksheetFunction.Subtotal(103, .Range("N1:N" & lastRow)) > 1 Then
        .Range("N2:N" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    .AutoFilterMode = False
    On Error GoTo 0
    End With

    Srk.Columns("N").Delete
    
Wk.Range("A1:A" & lastCol).Value = WorksheetFunction.Transpose(Srk.Range("A1", ColumnLetter & lastCol))

Set R = Srk.Range("A1").CurrentRegion
Vin = R.Value
ReDim Vout(1 To UBound(Vin, 1), 1 To 1)
lchkw = Srk.Cells(Rows.Count, "A").End(xlUp).Row

For i = 2 To UBound(Vin)
If i Mod 1 <> 1 Then
Vrw = R.Rows(i).Value
Vout = Application.Transpose(Vrw)
NxRw = IIf(IsEmpty(Wk.Range("DY1")), 1, Wk.Range("DY" & Rows.Count).End(xlUp).Row + 1)
Wk.Range("B" & NxRw).Resize(UBound(Vrw, 2), 1).Value = Vout
Second_Step_AI
End If

Call UpdateJVEntries
'Call Demo1bb8
Application.StatusBar = "Processing row " & i & " of " & lchkw & " - Running Time: " & Format(Now - timetaken, "hh:mm:ss")

Wk.UsedRange.Clear

Wk.Range("A1:A" & lastCol).Value = WorksheetFunction.Transpose(Srk.Range("A1", ColumnLetter & lastCol))

Next i

lastRow = ThisWorkbook.Sheets("JV").Cells(Rows.Count, 1).End(xlUp).Row ' Update last row after adding new rows
Dim xi As Long
Dim jvSheet As Worksheet
Set jvSheet = ThisWorkbook.Sheets("JV")

With jvSheet
    lastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
    .Range("H1:H" & lastRow).AutoFilter Field:=1, Criteria1:=0
    If Application.WorksheetFunction.Subtotal(103, .Columns("H:H")) > 1 Then
        .Range("H2:H" & lastRow).SpecialCells(xlCellTypeVisible).EntireRow.Delete
    End If
    .AutoFilterMode = False
End With

Call Get_DR_CR_Total_AI

timetaken = Now() - timetaken

With Enty.Cells.Font
    .Name = "Century Gothic"
    .Size = 9
End With
ActiveWindow.DisplayGridlines = False

Trg.UsedRange.Clear

MsgBox "Completed JV Booking !!! " & vbNewLine & vbNewLine & " Entry Validation Value -" & Enty.Range("M4").Value & vbNewLine & vbNewLine & " Time Taken is - " & Format(timetaken, "HH:MM:SS"), vbInformation, "Hi " & Application.UserName

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.DisplayStatusBar = False

End Sub

With only 6 500 lines so that should not be so slow but as I can't test without the same data …​

​

1 & 2. Obviously do not copy all the data but only the necessary just using a filter or better an advanced filter.​

3. ?​

4. The same as 1 & 2.​

5. Why move ? Just copy the necessary without the need to move anything …​

As previously discussed, I have translated my step-by-step process into a VBA coding format. This code was designed to facilitate the processing of our ERP report data, which users would download and then paste into our Source Data sheet. After which, we filter out the necessary data rows and subsequently, transfer them to our Pay Summary Sheet. This embodies the core of our coding process, which has been crafted meticulously to the best of my knowledge
.
However, I must candidly acknowledge that the current execution time for this code is more than 2 hours. This inefficient run-time has brought forth the need for optimization.
In light of this, I am humbly requesting your expert guidance to revamp and accelerate the efficiency of this code. For testing purposes, I have prepared the Summary Sheet, which you may freely replicate as needed.
Thank you for your understanding and support.

 

[vletm]

Gunasekaran​

You're asking to do something to Sub DataTranspose_Optimized_027()... because slow.
Are You sure that those two other 'Sub's do not make any delay?

 

[Gunasekaran]

Gunasekaran​

You're asking to do something to Sub DataTranspose_Optimized_027()... because slow.
Are You sure that those two other 'Sub's do not make any delay?

I need some help with optimizing my main Sub code, "Sub DataTranspose_Optimized_027()". It's currently running quite slowly, and I believe it could be improve for better performance. Within this Sub code, I have a few more Sub processes called using the "call" method.

I am reaching out to seek your expertise and support in optimizing this code. I have already tried to find solutions by searching this forum and doing Google searches, but I haven't been able to achieve the desired time results. The code takes more than 2 hours to execute, and I believe the issue is not with the number of lines but with the code itself.

If possible, Could spare some time to review my code and make improvement my code, it would be of great help to me. I value the collective knowledge and experience of this community,..

Looking forward to your valuable assistance.

 

[Marc L]

Taking a glance to your code and my eyes hurt, useless things, will pollute my mind if I go forward so better to not waste my time with it !​

​

More than 2 hours with few data ?‼ Which sheet contains those 6 500 lines ?​

​

Try first with a brand new workbook where you copy only the raw data without any formatting so do very not copy the sheets directly …​

If still long to execute then as requested in post #5 a before state workbook and an after state workboot attachment​

should be a good start to help with your best elaboration filling the holes, step by step, in order there is nothin' to guess …​

​

As a reminder an Excel Expert VBA procedure may be 100 times slower than a database software beginner code.​

​