how make this code faster(is too slow)

[tubrak]

hi
can any body help to make this code faster ,please ?
this code match data across multiple sheets and copy and merge duplicated data based on column B and calculate the quantity among the sheet

Sub calqt()
Dim Chk, Data, WsArr, Temp, i As Long, ii As Long, x As Long, rw As Long, Tm As Double
ReDim Temp(1 To 50000, 1 To 15): Tm = Timer
WsArr = [{"First", "Import", "Export", "Sales Returns", "Purchase Returns"}]
For i = 1 To UBound(WsArr)
    Data = Sheets(WsArr(i)).Cells(1).CurrentRegion.Value
    For ii = 2 To UBound(Data)
        Chk = Application.Match(Data(ii, 2), Application.Index(Temp, , 2), 0)
        If Not IsNumeric(Chk) Then
            x = x + 1
            Temp(x, 1) = x
            Temp(x, 2) = Data(ii, 2)
            Temp(x, 3) = Data(ii, 3)
            Temp(x, 4) = Data(ii, 4)
            Temp(x, 5) = Data(ii, 5)
            rw = x
        Else
            rw = Chk
        End If
        Temp(rw, i + 5) = Temp(rw, i + 5) + Data(ii, 6)
        If i = 1 Or i = 2 Then
            Temp(rw, 12) = Temp(rw, 12) + Data(ii, 7)
            Temp(rw, 14) = Temp(rw, 14) + 1
        End If
        If i = 1 Or i = 3 Then
            Temp(rw, 13) = Temp(rw, 13) + Data(ii, IIf(i = 1, 8, 7))
            Temp(rw, 15) = Temp(rw, 15) + 1
        End If
    Next ii
Next i
With Sheets("STOCK")
    .Range("A2").Resize(x, 15) = Temp
    .Range("K2:K" & x + 1).Formula = "=F2+G2-H2+I2-J2"
    With .Range("L2:L" & x + 1): .Value = Evaluate("=" & .Address & "/" & .Offset(, 2).Address & ""): End With
    With .Range("M2:M" & x + 1): .Value = Evaluate("=" & .Address & "/" & .Offset(, 2).Address & ""): End With
    .Columns(14).Resize(, 2).Delete: .UsedRange.Borders.Weight = 2
End With
MsgBox Format(Timer - Tm, "0.00")

End Sub

if any body interest I will attach the file if this is not enough to understand the code

 

[jasonb75]

How slow is too slow?

Simple things like setting screen updating to false and calculation to manual while the code runs can make a massive difference.
At the start to turn them off

With Application
    .ScreenUpdating = False
    .Calculation = xlManual
End With

At the end to turn them back on

With Application
    .ScreenUpdating = True
    .Calculation = xlAutomatic
End With

 

[tubrak]

How slow is too slow?

Compared to my simple data, its speed should at least be 0.03 .
Although using ARRAY but still gives code speed 2.61
Although I tested simple data about 20 rows in all sheets
About your suggestion made no difference

 

[jasonb75]

Compared to my simple data, its speed should at least be 0.03 .

Based on what evidence?

 

[tubrak]

Based on what evidence?

not exactly 0.03 but I gave you for example 0.04 or 0.05 but not reach 1.00 or 2.61 as in my case .

the code design for at least 50000 rows . this is not big data . as I said I just tested for 20 rows . is it reasonable to gives speed 2.61?

I see many codes in this forum just use loop without array . despite of this speed can't reach 1.00

 

[jasonb75]

There are many factors to take into consideration, not just the code. There is nothing in it that would cause slow running.

Other applications running on your device (including background processes) could be taking system resources away from excel. Your device might not be as powerful as the ones that the other code ran on.

Do you have any other code that could be executed when this finishes? For example, a worksheet change event in the 'Stock' sheet would run at least 4 times between the start and end points of your timer.

You could try using Debug.Print Format(Timer - Tm, "0.00") at various points in your code in order to establish if there is a specific section that is taking a lot of time compared to the rest. I would add it between Next ii and Next i in order to see how long each sheet is taking in the loop. Note that this would be the time from the start of the procedure, not the time of each individual loop.

 

[Alex Blakenburg]

I’m afraid I am a bit tied up for a couple of days but this line suggests you might need to be using a dictionary.

Chk = Application.Match(Data(ii, 2), Application.Index(Temp, , 2), 0)

This looks like a 1-50,000 item search on each iteration.

 

[jasonb75]

Good spot, Alex. I missed the application match line.

 

[tubrak]

@Alex Blakenburg thanks

you might need to be using a dictionary.

I have no experience about it

 

[Alex Blakenburg]

@Alex Blakenburg thanks

you might need to be using a dictionary.

I have no experience about it

I am in Australia and it is quite late here. If Jason can’t help have a look at this.
Excel Vba Dictionary of Arrays
Paul Kelly (Excel Macro Mastery) often uses a very basic class module, instead of the array used in the link.